module1.bas

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

Public Function WeekName(i As Date) As String
On Error GoTo dd
        Dim ii As Integer
        ii = Weekday(i)
        Select Case Weekday(ii)
            Case 1: WeekName = "星期日"
            Case 2: WeekName = "星期一"
            Case 3: WeekName = "星期二"
            Case 4: WeekName = "星期三"
            Case 5: WeekName = "星期四"
            Case 6: WeekName = "星期五"
            Case 7: WeekName = "星期六"
        End Select
Exit Function
dd:
End Function
Public Sub EditComInfo(IDNumber As Double)
On Error GoTo ddd
        Dim db As Database
        Dim rs As Recordset
        Set db = OpenDatabase(MdbPath)
        Set rs = db.OpenRecordset("select * from com where id=" & IDNumber)
        If rs.RecordCount = 0 Then
            MsgBox "程序定位数据出错，没有找到要修改的商家资料，可以尝试重新启动程序。", vbInformation, "定位出错"
            rs.Close
            Set rs = Nothing
            db.Close
            Set db = Nothing
            Exit Sub
        ElseIf rs.RecordCount = 1 Then
            If form3show = True Then
                Form3.SetFocus
            Else
                Load Form3
                Form3.Show
            End If
            Form3.Text1.Text = " " & MdbPath
            Form3.Text2.Text = rs!id
            Form3.Text14.Text = "  " & App.Major & "." & App.Minor & "." & App.Revision
            Form3.Text3.Text = rs!企业名称
            Form3.Text4.Text = rs!企业助记码
            Form3.Text5.Text = rs!企业性质
            Form3.Text6.Text = rs!企业行业
            Form3.Text7.Text = rs!企业地址
            Form3.Text8.Text = rs!邮政编码
            Form3.Text9.Text = rs!法人代表
            Form3.Text10.Text = rs!企业网址
            Form3.Text11.Text = rs!企业传真
            Form3.Text12.Text = rs!企业电话
            Form3.Text13.Text = rs!经营范围
            Form3.EditId.Caption = rs!id
            rs.Close
            Set rs = Nothing
            db.Close
            Set db = Nothing
        End If
        Exit Sub
ddd:
    MsgBox Err.Number & "：" & Err.Description
End Sub
Public Sub AddBaiFangSub(i As Long)
    If i = 0 Then
        Exit Sub
    End If
    If i < 0 Then
        Exit Sub
    End If
    Dim db As Database
    Dim rs As Recordset
    Set db = OpenDatabase(MdbPath)
    Set rs = db.OpenRecordset("select * from com where id = " & i)
    If rs.RecordCount = 0 Then
        MsgBox "在查询数据库的时候出现了错误，无法继续：在数据库中，没有找到单位的标志量，无法添加拜访记录。"
        rs.Close
        db.Close
        Set rs = Nothing
        Set db = Nothing
        Exit Sub
    End If
    If rs.RecordCount > 0 Then
        rs.MoveLast
        rs.MoveFirst
    End If
    If rs.RecordCount > 1 Then
        MsgBox "在查询数据库的时候出现了错误，无法继续：在数据库中，找到重复的单位的标志量，无法添加拜访记录。"
        rs.Close
        db.Close
        Set rs = Nothing
        Set db = Nothing
        Exit Sub
    End If
    If rs.RecordCount = 1 Then
        Load FrmBaiFangAdd
        FrmBaiFangAdd.Show
        FrmBaiFangAdd.Label2.Caption = i
        FrmBaiFangAdd.Text1.Text = rs!id & "：" & rs!企业名称

        FrmBaiFangAdd.DTPicker1.Value = Date
        
        FrmBaiFangAdd.Combo2.Clear
        Dim Db2 As Database
        Dim rs2 As Recordset
        Set Db2 = OpenDatabase(MdbPath)
        Set rs2 = Db2.OpenRecordset("select * from mycom")
        If rs2.RecordCount = 0 Then
            FrmBaiFangAdd.Combo2.Text = ""
        ElseIf rs2.RecordCount = 1 Then
            rs2.MoveLast
            rs2.MoveFirst
            Dim ii As Integer
            For ii = 1 To rs2.RecordCount
                FrmBaiFangAdd.Combo2.AddItem rs2!姓名
                rs2.MoveNext
            Next ii
        End If
        rs2.Close
        Db2.Close
        Set rs2 = Nothing
        Set Db2 = Nothing
        
        FrmBaiFangAdd.Combo1.Clear
        Dim db3 As Database
        Dim rs3 As Recordset
        Set db3 = OpenDatabase(MdbPath)
        Set rs3 = db3.OpenRecordset("select * from ren where 所属企业=" & i)
        If rs3.RecordCount = 1 Then
            rs3.MoveLast
            rs3.MoveFirst
            Dim i2 As Integer
            For i2 = 1 To rs3.RecordCount
              
                    FrmBaiFangAdd.Combo1.AddItem rs3!姓名 & " (" & rs3!部门 & rs3!职务 & ")"

                rs3.MoveNext
            Next i2
            rs3.Close
            db3.Close
            Set rs3 = Nothing
            Set db3 = Nothing
        End If
        FrmBaiFangAdd.Text2.Text = ""
    End If
End Sub

Public Sub ShowComBaifang(ComID As Long)
    If form13show = True Then
        Form13.SetFocus
        Form13.Text7.Text = ComID
    Else
        Load Form13
        Form13.Show
        Form13.Text7.Text = ComID
    End If
    Dim db As Database
    Dim rs As Recordset
    Set db = OpenDatabase(MdbPath)
    Set rs = db.OpenRecordset("select * from baifang where 企业ID号 =" & ComID & " order by id desc")
    
    If rs.RecordCount > 0 Then  '''''''''''''''''''''''''''''''''''这段代码为循环显示拜访记录到列表中。''''''''''''''''''
        Dim i As Integer
        Form13.Frame3.Visible = True
        Form13.Label5.Caption = "正在准备读取数据库 ... "
        Form13.Label5.Caption = "数据库已经打开，正在读取数据 ... "
        Form13.MSFlexGrid1.Cols = 5
        rs.MoveLast
        rs.MoveFirst
        Form13.MSFlexGrid1.Rows = rs.RecordCount + 1
        Form13.MSFlexGrid1.ColWidth(0) = 500
        Form13.MSFlexGrid1.ColWidth(1) = 1000
        Form13.MSFlexGrid1.ColWidth(2) = 1200
        Form13.MSFlexGrid1.ColWidth(3) = 1200
        Form13.MSFlexGrid1.ColWidth(4) = 7800
        Form13.MSFlexGrid1.TextMatrix(0, 0) = "ID"
        Form13.MSFlexGrid1.TextMatrix(0, 1) = "拜访时间"
        Form13.MSFlexGrid1.TextMatrix(0, 2) = "受访人"
        Form13.MSFlexGrid1.TextMatrix(0, 3) = "拜访人"
        Form13.MSFlexGrid1.TextMatrix(0, 4) = "内容"
        
        For i = 1 To rs.RecordCount
            Form13.Label5.Caption = "正在加载数据，请稍候 ... " & i & " " & "/" & rs.RecordCount
            Form13.MSFlexGrid1.TextMatrix(i, 0) = rs!id
            Form13.MSFlexGrid1.TextMatrix(i, 1) = rs!拜访时间
            Form13.MSFlexGrid1.TextMatrix(i, 2) = rs!受访人
            Form13.MSFlexGrid1.TextMatrix(i, 3) = rs!拜访人
            Form13.MSFlexGrid1.TextMatrix(i, 4) = rs!内容
            If rs.EOF Then
                Exit For
            Else
                rs.MoveNext
            End If
            DoEvents
        Next i
        Form13.Label5.Caption = "数据库读取完毕。"
        End If
        Form13.Label5.Caption = "正在关闭数据库 ... "
        rs.Close
        Set rs = db.OpenRecordset("select * from com where ID =" & ComID & " order by id desc")
        If rs.RecordCount = 0 Then
            MsgBox "数据出现了致命的错误，可能数据库已经紊乱，请立即和软件作者联系。软件在读取商家的信息的时候出现了错误：返回的商家集合为空！", vbInformation, "数据处理错误"
            rs.Close
            Set rs = Nothing
            db.Close
            Set db = Nothing
            Exit Sub
        ElseIf rs.RecordCount > 0 Then
        rs.MoveLast
        If rs.RecordCount = 1 Then
            Form13.Text1.Text = rs!企业名称
            Form13.Text2.Text = rs!企业电话
            Form13.Text3.Text = rs!企业地址
            If Trim(rs!邮政编码) <> "" Then
                Form13.Text3.Text = rs!企业地址 & " （" & rs!邮政编码 & " ）"
            End If
            Form13.Text4.Text = rs!法人代表
            
        ElseIf rs.RecordCount > 1 Then
            MsgBox "数据出现了致命的错误，可能数据库已经紊乱，请立即和软件作者联系。软件在读取商家的信息的时候出现了错误：返回的商家集合有多个商家！", vbInformation, "数据处理错误"
            rs.Close
            Set rs = Nothing
            db.Close
            Set db = Nothing
            Exit Sub
        End If
    End If
        rs.Close
        Set rs = Nothing
        db.Close
        Set db = Nothing
        Form13.Label5.Caption = "数据库加载完毕。"
        Form13.Frame3.Width = Form13.Label5.Width + 250
End Sub

Public Sub ShowComRen(ComID As Long)
    If frmshowallrenshow = True Then
        FrmShowAllRen.MSFlexGrid1.Clear
        FrmShowAllRen.MSFlexGrid1.Rows = 1
        ShowAllRen ("select * from ren where 所属企业 = " & ComID & " order by id desc")
    ElseIf frmshowallrenshow = False Then
        Load FrmShowAllRen
        FrmShowAllRen.Show
        FrmShowAllRen.MSFlexGrid1.Clear
        FrmShowAllRen.MSFlexGrid1.Rows = 1
        'ShowAllRen ("select * from ren where 所属企业 = " & Form3.EditId.Caption & " order by id desc")
        ShowAllRen ("select * from ren where 所属企业 = " & ComID & " order by id desc")
    End If

End Sub

Public Sub ShowRenInfo(id As Long)
On Error GoTo nextddd
    
    'Form5.Label13.Caption = FrmShowAllRen.MSFlexGrid1.TextMatrix(FrmShowAllRen.MSFlexGrid1.RowSel, 0)
    Form5.Label13.Caption = id
    Dim db As Database
    Dim rs As Recordset
    Set db = OpenDatabase(MdbPath)
    Set rs = db.OpenRecordset("select * from ren where id =" & id)
    If IsNull(rs!姓名) = False Then
    Form5.Text1.Text = rs!姓名
    End If
    If IsNull(rs!助记码) = False Then Form5.Text2.Text = rs!助记码
    If IsNull(rs!手机号码) = False Then Form5.Text3.Text = rs!手机号码
    If IsNull(rs!小灵通) = False Then Form5.Text4.Text = rs!小灵通
    If IsNull(rs!电子信箱) = False Then Form5.Text5.Text = rs!电子信箱
    If IsNull(rs!QQ号码) = False Then Form5.Text6.Text = rs!QQ号码
    If IsNull(rs!所属企业) = False Then Form5.Text7.Text = rs!所属企业
    If IsNull(rs!部门) = False Then Form5.Text8.Text = rs!部门
    If IsNull(rs!职务) = False Then Form5.Text9.Text = rs!职务
    If IsNull(rs!办公电话) = False Then Form5.Text10.Text = rs!办公电话
    If IsNull(rs!办公传真) = False Then Form5.Text11.Text = rs!办公传真
    If IsNull(rs!其他说明) = False Then Form5.Text12.Text = rs!其他说明
    If IsNull(rs!家庭电话) = False Then Form5.Text14.Text = rs!家庭电话
    If IsNull(rs!家庭地址) = False Then Form5.Text15.Text = rs!家庭地址
    If IsNull(rs!性别) = True Then
        Form5.Combo1.ListIndex = 0
    Else
        Form5.Combo1.ListIndex = Val(rs!性别)
    End If
    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
    Form5.SetFocus
    Exit Sub
nextddd:
    MsgBox Err.Number & "：" & Err.Description

End Sub