📄 会员信息.frm

📁 一个以SQL Server 2000为数据库
💻 FRM
📖 第 1 页 / 共 4 页
字号:
上一页 1 2 34
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Option Explicit
Private cnRecordSet As ADODB.Recordset


Private Sub Command10_Click()
Unload 会员信息
End Sub



Private Sub Command11_Click()
On Error GoTo ErrorHandle:
If txtCard_id = "" Or txtMem_ID.Text = "" Or txtPassword.Text = "" Or txtMem_type.Text = "" Or txtReg_admin.Text = "" Then
MsgBox "带星号的位置不能为空！", vbOKOnly, "警告！"
Exit Sub
End If
Dim sql As String
sql = "insert into Member_Basic_Info values ( '"
sql = sql + txtCard_id.Text + "','"
sql = sql + txtPassword.Text + "','"
sql = sql + txtMem_name.Text + "','"
sql = sql + txtMem_ID.Text + "','"
sql = sql + txtGender.Text + "','"
sql = sql + txtMem_addr.Text + "','"
sql = sql + txtMem_tel.Text + "','"
sql = sql + txtMem_mail.Text + "','"
sql = sql + txtReg_date.Text + "','"
sql = sql + txtReg_admin.Text + "')"
Form1.cnTest.Execute (sql)
sql = ""
sql = "insert into Member_dynamic_Info values('"
sql = sql + txtCard_id.Text + "','"
sql = sql + txtMem_type.Text + "','"
sql = sql + txtMem_money.Text + "',"
sql = sql + "'0','0','否','0')"
Form1.cnTest.Execute (sql)
MsgBox "添加资料成功！", vbOKOnly, "操作信息"
Exit Sub
ErrorHandle:
    Select Case (Err.Number)
        Case -2147217873:
            MsgBox "会员编号已存在，或管理员编号不存在！", vbExclamation, "错误"
        Case -2147217913:
            MsgBox "某些数据格式不正确！", vbExclamation, "错误"
        Case -2147217833:
            MsgBox "某些数据超过存储范围请缩小其值", vbExclamation, "错误"
        Case Else:
            MsgBox Err.Number & vbCrLf & Err.Description, vbExclamation, "Error"
    End Select
    On Error GoTo 0
    Exit Sub
End Sub

Private Sub Command12_Click()
On Error GoTo ErrorHandle:
Dim sql As String
sql = "delete from Member_dynamic_Info "
sql = sql + "where Card_ID = '" + txtCard_id2.Text + "'"
Form1.cnTest.Execute (sql)
sql = ""
sql = "delete from Member_Basic_Info "
sql = sql + "where Card_ID = '" + txtCard_id2.Text + "'and "
sql = sql + "Mem_name = '" + txtMem_name2.Text + "' and "
sql = sql + "IdentityID = '" + txtID2.Text + "'"
Form1.cnTest.Execute (sql)
MsgBox "修改资料成功！", vbOKOnly, "操作信息"
Exit Sub
ErrorHandle:
    Select Case (Err.Number)
        Case -2147217873:
            MsgBox "会员编号已存在，或管理员编号不存在！", vbExclamation, "错误"
        Case -2147217913:
            MsgBox "某些数据格式不正确！", vbExclamation, "错误"
        Case -2147217833:
            MsgBox "某些数据超过存储范围请缩小其值", vbExclamation, "错误"
        Case Else:
            MsgBox Err.Number & vbCrLf & Err.Description, vbExclamation, "Error"
    End Select
    On Error GoTo 0
    Exit Sub
End Sub
Private Sub Command3_Click()
txtCard_id1.Text = ""
txtMem_name1.Text = ""
txtID1.Text = ""
End Sub

Private Sub Command5_Click()
On Error GoTo ErrorHandle:
Dim sql As String
sql = "select Member_Basic_Info.Card_ID ,Mem_name,IdentityID,Mem_gender,Mem_type,Mem_address,Mem_tel,Mem_mail,Register_date,AdminId,Overdays,Card_loss,Addup_money,Card_money,CD_num from Member_Basic_Info,Member_dynamic_Info where Member_Basic_Info.Card_ID = Member_dynamic_Info.Card_ID and Member_Basic_Info.Card_ID like '%"
sql = sql + txtCard_id1.Text + "%' and "
sql = sql + "Mem_name like '%" + txtMem_name1.Text + "%' and "
sql = sql + "IdentityID like '%" + txtID1.Text + "%'"
Set cnRecordSet = Form1.cnTest.Execute(sql)

If cnRecordSet.EOF = True Then
MsgBox "没有该条记录", vbOKOnly, "错误！"
Exit Sub
End If
Dim item As ListItem
ListView1.ListItems.Clear
Do While cnRecordSet.EOF = False
    Set item = ListView1.ListItems.Add
    If cnRecordSet.Fields.item(0).Value <> "" Then
    item.Text = cnRecordSet.Fields.item(0).Value
    End If
    If cnRecordSet.Fields.item(1).Value <> "" Then
    item.SubItems(1) = cnRecordSet.Fields.item(1).Value
    End If
    If cnRecordSet.Fields.item(2).Value <> "" Then
    item.SubItems(2) = cnRecordSet.Fields.item(2).Value
    End If
    If cnRecordSet.Fields.item(3).Value <> "" Then
    item.SubItems(3) = cnRecordSet.Fields.item(3).Value
    End If
    If cnRecordSet.Fields.item(4).Value <> "" Then
    item.SubItems(4) = cnRecordSet.Fields.item(4).Value
    End If
    If cnRecordSet.Fields.item(5).Value <> "" Then
    item.SubItems(5) = cnRecordSet.Fields.item(5).Value
    End If
    If cnRecordSet.Fields.item(6).Value <> "" Then
    item.SubItems(6) = cnRecordSet.Fields.item(6).Value
    End If
    If cnRecordSet.Fields.item(7).Value <> "" Then
    item.SubItems(7) = cnRecordSet.Fields.item(7).Value
    End If
    If cnRecordSet.Fields.item(8).Value <> "" Then
    item.SubItems(8) = cnRecordSet.Fields.item(8).Value
    End If
    If cnRecordSet.Fields.item(9).Value <> "" Then
    item.SubItems(9) = cnRecordSet.Fields.item(9).Value
    End If
    If cnRecordSet.Fields.item(10).Value <> "" Then
    item.SubItems(10) = cnRecordSet.Fields.item(10).Value
    End If
    If cnRecordSet.Fields.item(11).Value <> "" Then
    item.SubItems(11) = cnRecordSet.Fields.item(11).Value
    End If
    If cnRecordSet.Fields.item(12).Value <> "" Then
    item.SubItems(12) = cnRecordSet.Fields.item(12).Value
    End If
    If cnRecordSet.Fields.item(13).Value <> "" Then
    item.SubItems(13) = cnRecordSet.Fields.item(13).Value
    End If
    If cnRecordSet.Fields.item(14).Value <> "" Then
    item.SubItems(14) = cnRecordSet.Fields.item(14).Value
    End If
    cnRecordSet.MoveNext
Loop
Exit Sub
ErrorHandle:
    Select Case (Err.Number)
        Case -2147217873:
            MsgBox "会员编号已存在，或管理员编号不存在！", vbExclamation, "错误"
        Case -2147217913:
            MsgBox "某些数据格式不正确！", vbExclamation, "错误"
        Case -2147217833:
            MsgBox "某些数据超过存储范围请缩小其值", vbExclamation, "错误"
        Case Else:
            MsgBox Err.Number & vbCrLf & Err.Description, vbExclamation, "Error"
    End Select
    On Error GoTo 0
    Exit Sub
End Sub

Private Sub Command6_Click()
Command12.Enabled = False
Command7.Enabled = False
txtMem_loss.Text = ""
txtCard_id2.Text = ""
txtMem_name2.Text = ""
txtMem_name3.Text = ""
txtID2.Text = ""
txtID3.Text = ""
txtPassword1.Text = ""
txtMem_gender1.Text = ""
txtMem_type1.Text = ""
txtMem_tel1.Text = ""
txtMem_mail1.Text = ""
txtMem_addr1.Text = ""
txtMem_money1.Text = ""
txtMem_breaknum.Text = ""
txtMem_brownum.Text = ""
End Sub

Private Sub Command7_Click()
On Error GoTo ErrorHandle:

Dim sql As String
sql = "update Member_Basic_Info "
sql = sql + "set Mem_name = '" + txtMem_name3.Text + "' "
sql = sql + ", IdentityID = '" + txtID3.Text + "' "
sql = sql + ", Password = '" + txtPassword1.Text + "' "
sql = sql + ", Mem_gender = '" + txtMem_gender1.Text + "' "
sql = sql + ", Mem_address = '" + txtMem_addr1.Text + "' "
sql = sql + ", Mem_tel = '" + txtMem_tel1.Text + "' "
sql = sql + ", Mem_mail= '" + txtMem_mail1.Text + "'"
sql = sql + "where Card_ID = '" + txtCard_id2.Text + "'and "
sql = sql + "Mem_name = '" + txtMem_name2.Text + "' and "
sql = sql + "IdentityID = '" + txtID2.Text + "'"
Form1.cnTest.Execute (sql)
sql = ""
sql = "update Member_dynamic_Info "
sql = sql + "set Mem_type = '" + txtMem_type1.Text + "' "
sql = sql + ", Card_money = '" + txtMem_money1.Text + "' "
sql = sql + ", Addup_money = '" + txtMem_brownum.Text + "' "
sql = sql + ", Overdays = '" + txtMem_breaknum.Text + "' "
sql = sql + ",Card_loss = '" + txtMem_loss.Text + "'"
sql = sql + "where Card_ID = '" + txtCard_id2.Text + "'"
Form1.cnTest.Execute (sql)

MsgBox "修改资料成功！", vbOKOnly, "操作信息"


Exit Sub
ErrorHandle:
    Select Case (Err.Number)
        Case -2147217873:
            MsgBox "会员编号已存在，或管理员编号不存在！", vbExclamation, "错误"
        Case -2147217913:
            MsgBox "某些数据格式不正确！", vbExclamation, "错误"
        Case -2147217833:
            MsgBox "某些数据超过存储范围请缩小其值", vbExclamation, "错误"
        Case Else:
            MsgBox Err.Number & vbCrLf & Err.Description, vbExclamation, "Error"
    End Select
    On Error GoTo 0
    Exit Sub
End Sub

Private Sub Command8_Click()
On Error GoTo ErrorHandle:
If txtCard_id2.Text = "" And txtID2.Text = "" Then
MsgBox "请输入会员号或证件号中的至少一个", vbOKOnly, "警告！"
Exit Sub
End If
Dim sql As String
sql = "select Mem_name,IdentityID,Mem_gender,Mem_type,Mem_address,Mem_tel,Mem_mail,Overdays,Card_loss,Addup_money,Card_money,Password,Member_Basic_Info.Card_ID from Member_Basic_Info,Member_dynamic_Info where Member_Basic_Info.Card_ID = Member_dynamic_Info.Card_ID and Member_Basic_Info.Card_ID like '%"
sql = sql + txtCard_id2.Text + "%' and "
sql = sql + "Mem_name like '%" + txtMem_name2.Text + "%' and "
sql = sql + "IdentityID like '%" + txtID2.Text + "%'"
Set cnRecordSet = Form1.cnTest.Execute(sql)
If cnRecordSet.EOF = True Then
MsgBox "没有该条记录", vbOKOnly, "错误！"
Command12.Enabled = False
Command7.Enabled = False
Exit Sub
End If
    If cnRecordSet.Fields.item(0).Value <> "" Then
    txtMem_name3.Text = cnRecordSet.Fields.item(0).Value
    End If
    If cnRecordSet.Fields.item(1).Value <> "" Then
    txtID3.Text = cnRecordSet.Fields.item(1).Value
    End If
    If cnRecordSet.Fields.item(12).Value <> "" Then
    txtCard_id2 = cnRecordSet.Fields.item(12).Value
    End If
    If cnRecordSet.Fields.item(0).Value <> "" Then
    txtMem_name2 = cnRecordSet.Fields.item(0).Value
    End If
    If cnRecordSet.Fields.item(1).Value <> "" Then
    txtID2.Text = cnRecordSet.Fields.item(1).Value
    End If
    If cnRecordSet.Fields.item(2).Value <> "" Then
    txtMem_gender1.Text = cnRecordSet.Fields.item(2).Value
    End If
    If cnRecordSet.Fields.item(3).Value <> "" Then
    txtMem_type1.Text = cnRecordSet.Fields.item(3).Value
    End If
    If cnRecordSet.Fields.item(4).Value <> "" Then
    txtMem_addr1.Text = cnRecordSet.Fields.item(4).Value
    End If
    If cnRecordSet.Fields.item(5).Value <> "" Then
    txtMem_tel1.Text = cnRecordSet.Fields.item(5).Value
    End If
    If cnRecordSet.Fields.item(6).Value <> "" Then
    txtMem_mail1.Text = cnRecordSet.Fields.item(6).Value
    End If
    If cnRecordSet.Fields.item(7).Value <> "" Then
    txtMem_breaknum.Text = cnRecordSet.Fields.item(7).Value
    End If
    If cnRecordSet.Fields.item(8).Value <> "" Then
      txtMem_loss.Text = cnRecordSet.Fields.item(8).Value
      End If
      If cnRecordSet.Fields.item(9).Value <> "" Then
    txtMem_brownum.Text = cnRecordSet.Fields.item(9).Value
    End If
    If cnRecordSet.Fields.item(10).Value <> "" Then
    txtMem_money1.Text = cnRecordSet.Fields.item(10).Value
    End If
    If cnRecordSet.Fields.item(11).Value <> "" Then
    txtPassword1.Text = cnRecordSet.Fields.item(11).Value
    End If
    Command12.Enabled = True
    Command7.Enabled = True
    Exit Sub
ErrorHandle:
    Select Case (Err.Number)
        Case -2147217873:
            MsgBox "会员编号已存在，或管理员编号不存在！", vbExclamation, "错误"
        Case -2147217913:
            MsgBox "某些数据格式不正确！", vbExclamation, "错误"
        Case -2147217833:
            MsgBox "某些数据超过存储范围请缩小其值", vbExclamation, "错误"
        Case Else:
            MsgBox Err.Number & vbCrLf & Err.Description, vbExclamation, "Error"
    End Select
    On Error GoTo 0
    Exit Sub
End Sub

Private Sub Command9_Click()
txtCard_id.Text = ""
txtMem_name.Text = ""
txtMem_ID.Text = ""
txtPassword.Text = ""
txtGender.Text = ""
txtMem_type.Text = ""
txtMem_tel.Text = ""
txtMem_mail.Text = ""
txtReg_admin.Text = ""
txtReg_date.Text = ""
txtMem_money.Text = ""
End Sub

Private Sub Form_Load()
Dim sql As String
sql = "select getdate()"
Set cnRecordSet = Form1.cnTest.Execute(sql)
    txtReg_date.Text = cnRecordSet.Fields.item(0).Value
End Sub

Private Sub ListView1_DblClick()
 
    txtMem_name3.Text = ListView1.SelectedItem.SubItems(1)
    txtID3.Text = ListView1.SelectedItem.SubItems(2)
    txtCard_id2.Text = ListView1.SelectedItem.Text
    txtMem_name2.Text = ListView1.SelectedItem.SubItems(1)
    txtID2.Text = ListView1.SelectedItem.SubItems(2)
    txtMem_gender1.Text = ListView1.SelectedItem.SubItems(3)
    txtMem_type1.Text = ListView1.SelectedItem.SubItems(4)
    txtMem_addr1.Text = ListView1.SelectedItem.SubItems(5)
    txtMem_tel1.Text = ListView1.SelectedItem.SubItems(6)
    txtMem_mail1.Text = ListView1.SelectedItem.SubItems(7)
    txtMem_breaknum.Text = ListView1.SelectedItem.SubItems(10)
    txtMem_loss.Text = ListView1.SelectedItem.SubItems(11)
    txtMem_brownum.Text = ListView1.SelectedItem.SubItems(12)
    txtMem_money1.Text = ListView1.SelectedItem.SubItems(13)
    SSTab1.Tab = 2
    Command12.Enabled = True
    Command7.Enabled = True
End Sub


Private Sub tuichu_Click()
End
End Sub
上一页 1 2 34
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -