main.frm

软件用到的技巧：透明窗体

    End If
End Sub

Private Sub Mjiluxiugai_Click()
On Error GoTo clickerror
    If AllBaiFangShow = False Then
        Load AllBaiFang
        AllBaiFang.Show
            Dim db1 As Database
            Dim rs1 As Recordset
            Set db1 = OpenDatabase(MdbPath)
            Set rs1 = db1.OpenRecordset("select listnum from proset")
            Dim dbb As Database
            Dim rss As Recordset
            Set dbb = OpenDatabase(MdbPath)
            Set rss = dbb.OpenRecordset("select * from baifang")
            If rss.RecordCount > 0 Then
                rss.MoveLast
                rss.MoveFirst
            End If
            If IsNull(rs1!ListNum) = True Then
                ShowAllBaiFang ("select * from baifang order by id desc")
            ElseIf Val(rs1!ListNum) = 0 Then
                ShowAllBaiFang ("select * from baifang order by id desc")
            ElseIf Val(rs1!ListNum) > 0 Then
                If rss.RecordCount < Val(rs1!ListNum) Then
                    ShowAllBaiFang ("select * from baifang order by id desc")
                ElseIf rss.RecordCount >= Val(rs1!ListNum) Then
                    ShowAllBaiFang ("select top " & Val(rs1!ListNum) & " * from baifang order by id desc")
                End If
            End If
            rss.Close
            dbb.Close
            Set rss = Nothing
            Set dbb = Nothing
            rs1.Close
            db1.Close
            Set rs1 = Nothing
            Set db1 = Nothing
        Exit Sub
    Else
        AllBaiFang.SetFocus
    End If
    If AllBaiFang.MSFlexGrid1.TextMatrix(0, 0) = "" Then Exit Sub
    If AllBaiFang.MSFlexGrid1.Rows = 1 Then
        MsgBox "没有可以供修改的拜访记录！", vbInformation, "拜访记录为空"
        Exit Sub
    End If
    Load FrmBaiFangEdit
    FrmBaiFangEdit.Show
    FrmBaiFangEdit.Label2.Caption = AllBaiFang.MSFlexGrid1.TextMatrix(AllBaiFang.MSFlexGrid1.RowSel, 1)
    FrmBaiFangEdit.Text3.Text = AllBaiFang.MSFlexGrid1.TextMatrix(AllBaiFang.MSFlexGrid1.RowSel, 0)
    
    Dim db As Database
    Dim rs As Recordset
    Set db = OpenDatabase(MdbPath)
    Set rs = db.OpenRecordset("select * from com where id=" & AllBaiFang.MSFlexGrid1.TextMatrix(AllBaiFang.MSFlexGrid1.RowSel, 1))
    If rs.RecordCount > 0 Then
        FrmBaiFangEdit.Text1.Text = rs!企业名称
    ElseIf rs.RecordCount = 0 Then
        MsgBox "取商家的名称错误，无法显示拜访记录。", vbInformation, "定位商家的名称错误"
        rs.Close
        Set rs = Nothing
        db.Close
        Set db = Nothing
        Exit Sub
    End If
    Set rs = db.OpenRecordset("select * from baifang where id=" & Val(AllBaiFang.MSFlexGrid1.TextMatrix(AllBaiFang.MSFlexGrid1.RowSel, 0)))
    If rs.RecordCount = 0 Then
        MsgBox "数据库取数出现混乱,程序无法正确定位要修改的资料,可以尝试重新启动程序,或和程序提供者联系寻找解决途径。"
        
        rs.Close
        Set rs = Nothing
        db.Close
        Set db = Nothing
        Exit Sub
    End If
    If rs.RecordCount > 0 Then
        If rs!企业ID号 <> AllBaiFang.MSFlexGrid1.TextMatrix(AllBaiFang.MSFlexGrid1.RowSel, 1) Then
            MsgBox "数据库取数出现混乱,程序无法正确定位要修改的资料,可以尝试重新启动程序,或和程序提供者联系寻找解决途径。"
            rs.Close
            Set rs = Nothing
            db.Close
            Set db = Nothing
            Exit Sub
        Else
            FrmBaiFangEdit.Text2.Text = rs!内容
            Dim db3 As Database
            Dim rs3 As Recordset
            Set db3 = OpenDatabase(MdbPath)
            Set rs3 = db3.OpenRecordset("select * from ren where 所属企业=" & AllBaiFang.MSFlexGrid1.TextMatrix(AllBaiFang.MSFlexGrid1.RowSel, 1))
            If rs3.RecordCount = 1 Then
                rs3.MoveLast
                rs3.MoveFirst
                Dim i2 As Integer
                For i2 = 1 To rs3.RecordCount
                    FrmBaiFangEdit.Combo1.AddItem rs3!姓名 & " (" & rs3!部门 & rs3!职务 & ")"
                    rs3.MoveNext
                Next i2
                rs3.Close
                db3.Close
                Set rs3 = Nothing
                Set db3 = Nothing
            End If

            FrmBaiFangEdit.Combo1.Text = rs!受访人

            FrmBaiFangEdit.Combo2.Clear
            FrmBaiFangEdit.Combo2.Text = rs!拜访人
                Dim Db2 As Database
                Dim rs2 As Recordset
                Set Db2 = OpenDatabase(MdbPath)
                Set rs2 = Db2.OpenRecordset("select * from mycom")
                If rs2.RecordCount = 0 Then
                    FrmBaiFangEdit.Combo2.Text = ""
                ElseIf rs2.RecordCount = 1 Then
                    rs2.MoveLast
                    rs2.MoveFirst
                    Dim i As Integer
                    For i = 1 To rs2.RecordCount
                        FrmBaiFangEdit.Combo2.AddItem rs2!姓名
                        rs2.MoveNext
                    Next i
                End If
                rs2.Close
                Db2.Close
                Set rs2 = Nothing
                Set Db2 = Nothing
            FrmBaiFangEdit.DTPicker1.Value = rs!拜访时间
            rs.Close
            Set rs = Nothing
            db.Close
            Set db = Nothing
        End If
    End If
    Exit Sub
clickerror:
If Err.Number <> 0 Then
    MsgBox Err.Description, vbInformation, "执行错误"
End If
End Sub

Private Sub MLianxirenChaxun_Click()
    Load Form9
    Form9.Show
End Sub

Private Sub MLianxirenShanchu_Click()
    If frmshowallrenshow = False Then
        Load FrmShowAllRen
        FrmShowAllRen.Show

            Dim db1 As Database
            Dim rs1 As Recordset
            Set db1 = OpenDatabase(MdbPath)
            Set rs1 = db1.OpenRecordset("select listnum from proset")
            Dim dbb As Database
            Dim rss As Recordset
            Set dbb = OpenDatabase(MdbPath)
            Set rss = dbb.OpenRecordset("select * from ren")
            If rss.RecordCount > 0 Then
                rss.MoveLast
                rss.MoveFirst
            End If
            If IsNull(rs1!ListNum) = True Then
                ShowAllRen ("select * from ren order by id desc")
            ElseIf Val(rs1!ListNum) = 0 Then
                ShowAllRen ("select * from ren order by id desc")
            ElseIf Val(rs1!ListNum) > 0 Then
                If rss.RecordCount < Val(rs1!ListNum) Then
                    ShowAllRen ("select * from ren order by id desc")
                ElseIf rss.RecordCount >= Val(rs1!ListNum) Then
                    ShowAllRen ("select top " & Val(rs1!ListNum) & " * from ren order by id desc")
                End If
            End If
            rss.Close
            dbb.Close
            Set rss = Nothing
            Set dbb = Nothing
            rs1.Close
            db1.Close
            Set rs1 = Nothing
            Set db1 = Nothing
    Else
        If MsgBox("将要删除【" & FrmShowAllRen.MSFlexGrid1.TextMatrix(FrmShowAllRen.MSFlexGrid1.RowSel, 1) & "】的联系资料吗？该操作将不可恢复，并且，该操作仅仅删除联系人数据库中的个人资料，并不删除拜访记录中的含有该联系人的拜访记录。", vbQuestion + vbYesNo + vbDefaultButton2, "删除确认") = vbYes Then
            Dim db As Database
            Dim rs As Recordset
            Set db = OpenDatabase(MdbPath)
            Set rs = db.OpenRecordset("select * from ren where id=" & Val(FrmShowAllRen.MSFlexGrid1.TextMatrix(FrmShowAllRen.MSFlexGrid1.RowSel, 0)))
                If rs.RecordCount = 0 Then
                    MsgBox "数据库定位出错，定位选择的联系人的时候，返回的查询记录结果为0，应该为1的。", vbCritical, "查询返回值错误"
                    rs.Close
                    db.Close
                    Set rs = Nothing
                    Set db = Nothing
                ElseIf rs.RecordCount = 1 Then
                    rs.Delete
                    rs.Close
                    db.Close
                    Set rs = Nothing
                    Set db = Nothing
                    MsgBox "删除联系人的操作已经执行完毕。", vbInformation, "完毕"
                    ShowAllRen (FrmShowAllRen.Label1.Caption)
                    SumNumber '求各个表中的记录数总和
                ElseIf rs.RecordCount > 1 Then
                    MsgBox "定位要删除的联系人的时候出现了错误，返回的查询结果集应该只有一条记录的，但是现在的返回结果不止一条，返回值非预期值，错误！！！", vbCritical, "记录不唯一"
                    rs.Close
                    Set rs = Nothing
                    db.Close
                    Set db = Nothing
                End If
        End If
    End If
End Sub

Private Sub MLianxirenTianjia_Click()
    Load FrmRenAdd
    FrmRenAdd.Show
End Sub

Private Sub MLianxirenXianshisuoyou_Click()
If frmshowallrenshow = True Then

    FrmShowAllRen.SetFocus
Else
    Load FrmShowAllRen
    FrmShowAllRen.Show
    Dim db As Database
    Dim rs As Recordset
    Set db = OpenDatabase(MdbPath)
    Set rs = db.OpenRecordset("select * from proset")
    Dim dbb As Database
    Dim rss As Recordset
    Set dbb = OpenDatabase(MdbPath)
    Set rss = dbb.OpenRecordset("select * from ren")
    If rss.RecordCount > 0 Then
        rss.MoveLast
        rss.MoveFirst
    End If
    If IsNull(rs!texta) = True Then
        rs.Edit
            rs!texta = "否"
        rs.Update
    End If
    Dim bystr As String
    If rs!texta = "是" Then
        bystr = "姓名"
    ElseIf rs!texta = "否" Then
        bystr = "ID desc"
    Else
        bystr = "ID desc"
    End If
    
    
    
    If IsNull(rs!ListNum) = True Then
        ShowAllRen ("select * from ren order by " & bystr)
    ElseIf Val(rs!ListNum) = 0 Then
        ShowAllRen ("select * from ren order by " & bystr)
    ElseIf Val(rs!ListNum) > 0 Then
        If rss.RecordCount < Val(rs!ListNum) Then
            ShowAllRen ("select * from ren order by " & bystr)
        ElseIf rss.RecordCount >= Val(rs!ListNum) Then
            ShowAllRen ("select top " & Val(rs!ListNum) & " * from ren order by " & bystr)
        End If
    End If
    rss.Close
    dbb.Close
    Set rss = Nothing
    Set dbb = Nothing
    rs.Close
    db.Close
    Set rs = Nothing
    Set db = Nothing
End If
End Sub

Private Sub MLianxirenXiugai_Click()
    If form5show = True Then
        Form5.SetFocus
    Else
        If frmshowallrenshow = True Then
            If FrmShowAllRen.MSFlexGrid1.Rows = 1 Then
                If form5show = True Then
                    Unload Form5
                End If
                
                Exit Sub
            End If
            Form5.Label13.Caption = FrmShowAllRen.MSFlexGrid1.TextMatrix(FrmShowAllRen.MSFlexGrid1.RowSel, 0)
            Dim db As Database
            Dim rs As Recordset
            Set db = OpenDatabase(MdbPath)
            Set rs = db.OpenRecordset("select * from ren order by id desc ")
            If rs.RecordCount = 0 Then
                rs.Close
                db.Close
                Set rs = Nothing
                Set db = Nothing
                
                Exit Sub
            End If
            Set rs = db.OpenRecordset("select * from ren where id =" & Val(Form5.Label13.Caption))
            Form5.Text1.Text = rs!姓名
            Form5.Text2.Text = rs!助记码
            Form5.Text3.Text = rs!手机号码
            Form5.Text4.Text = rs!小灵通
            Form5.Text5.Text = rs!电子信箱
            Form5.Text6.Text = rs!QQ号码
            Form5.Text7.Text = rs!所属企业
            
            Form5.Text8.Text = rs!部门
            Form5.Text9.Text = rs!职务
            Form5.Text10.Text = rs!办公电话
            Form5.Text11.Text = rs!办公传真
            Form5.Text12.Text = rs!其他说明
            
            Form5.Text14.Text = rs!家庭电话
            Form5.Text15.Text = rs!家庭地址
            Form5.Combo1.ListIndex = rs!性别
            Dim Db2 As Database
            Dim rs2 As Recordset
            Set Db2 = OpenDatabase(MdbPath)
            Set rs2 = db.OpenRecordset("select * from com where id=" & rs!所属企业)
            If rs2.RecordCount = 1 Then
                Form5.Text13.Text = rs2!企业名称
                rs2.Close
                Db2.Close
                Set rs2 = Nothing
                Set Db2 = Nothing
            Else
                Form5.Text13.Text = "(取企业名称失败!)"
                rs2.Close
                Db2.Close
                Set rs2 = Nothing
                Set Db2 = Nothing
            End If
        Else
            FrmShowAllRen.Show
            Dim db1 As Database
            Dim rs1 As Recordset
            Set db1 = OpenDatabase(MdbPath)
            Set rs1 = db1.OpenRecordset("select listnum from proset")
            Dim dbb As Database
            Dim rss As Recordset
            Set dbb = OpenDatabase(MdbPath)
            Set rss = dbb.OpenRecordset("select * from ren")
            If rss.RecordCount > 0 Then
                rss.MoveLast
                rss.MoveFirst
            End If
            If IsNull(rs1!ListNum) = True Then
                ShowAllRen ("select * from ren order by id desc")
            ElseIf Val(rs1!ListNum) = 0 Then
                ShowAllRen ("select * from ren order by id desc")
            ElseIf Val(rs1!ListNum) > 0 Then
                If rss.RecordCount < Val(rs1!ListNum) Then
                    ShowAllRen ("select * from ren order by id desc")
                ElseIf rss.RecordCount >= Val(rs1!ListNum) Then
                    ShowAllRen ("select top " & Val(rs1!ListNum) & " * from ren order by id desc")
                End If
            End If
            rss.Close
            dbb.Close
            Set rss = Nothing
            Set dbb = Nothing
            rs1.Close
            db1.Close
            Set rs1 = Nothing
            Set db1 = Nothing

        End If