module1.bas

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

    FrmShowAllRen.MSFlexGrid1.ColAlignment(0) = 4
    FrmShowAllRen.MSFlexGrid1.Rows = rs.RecordCount + 1
    Dim i As Integer
    Dim t As Integer
    t = rs.RecordCount
    For i = 1 To t
        FrmShowAllRen.MSFlexGrid1.TextMatrix(r, 0) = rs!id
        If IsNull(rs!姓名) = False Then
            FrmShowAllRen.MSFlexGrid1.TextMatrix(r, 1) = rs!姓名
        End If
        If IsNull(rs!助记码) = False Then
        FrmShowAllRen.MSFlexGrid1.TextMatrix(r, 2) = rs!助记码
        End If
        If IsNull(rs!性别) = False Then
            FrmShowAllRen.MSFlexGrid1.TextMatrix(r, 3) = rs!性别
            If rs!性别 = 0 Then FrmShowAllRen.MSFlexGrid1.TextMatrix(r, 3) = ""
            If rs!性别 = 1 Then FrmShowAllRen.MSFlexGrid1.TextMatrix(r, 3) = "男"
            If rs!性别 = 2 Then FrmShowAllRen.MSFlexGrid1.TextMatrix(r, 3) = "女"
        End If
        If IsNull(rs!所属企业) = False Then
            FrmShowAllRen.MSFlexGrid1.TextMatrix(r, 4) = rs!所属企业
            Dim d As Database
            Dim rst As Recordset
            Set d = OpenDatabase(MdbPath)
            Set rst = db.OpenRecordset("select * from com where id=" & rs!所属企业)
            If rst.RecordCount > 0 Then
                FrmShowAllRen.MSFlexGrid1.TextMatrix(r, 4) = rst!企业名称
            Else
                FrmShowAllRen.MSFlexGrid1.TextMatrix(r, 4) = "（没有找到相应的商家）"
            End If
            d.Close
            rst.Close
            Set d = Nothing
            Set rst = Nothing
        ElseIf IsNull(rs!所属企业) = True Then
            FrmShowAllRen.MSFlexGrid1.TextMatrix(r, 4) = "（没有找到相应的商家）"
        End If
        If IsNull(rs!手机号码) = False Then
            FrmShowAllRen.MSFlexGrid1.TextMatrix(r, 5) = rs!手机号码
        End If
        If IsNull(rs!小灵通) = False Then
            FrmShowAllRen.MSFlexGrid1.TextMatrix(r, 6) = rs!小灵通
        End If
        If IsNull(rs!部门) = False Then
            FrmShowAllRen.MSFlexGrid1.TextMatrix(r, 7) = rs!部门
        End If
        If IsNull(rs!职务) = False Then
            FrmShowAllRen.MSFlexGrid1.TextMatrix(r, 8) = rs!职务
        End If
        If IsNull(rs!办公电话) = False Then
            FrmShowAllRen.MSFlexGrid1.TextMatrix(r, 9) = rs!办公电话
        End If
        If IsNull(rs!办公传真) = False Then
            FrmShowAllRen.MSFlexGrid1.TextMatrix(r, 10) = rs!办公传真
        End If
        If IsNull(rs!QQ号码) = False Then
            FrmShowAllRen.MSFlexGrid1.TextMatrix(r, 11) = rs!QQ号码
        End If
        If IsNull(rs!电子信箱) = False Then
            FrmShowAllRen.MSFlexGrid1.TextMatrix(r, 12) = rs!电子信箱
        End If
        If IsNull(rs!其他说明) = False Then
            FrmShowAllRen.MSFlexGrid1.TextMatrix(r, 15) = rs!其他说明
        End If
        If IsNull(rs!家庭电话) = False Then
            FrmShowAllRen.MSFlexGrid1.TextMatrix(r, 13) = rs!家庭电话
        End If
        If IsNull(rs!家庭地址) = False Then
            FrmShowAllRen.MSFlexGrid1.TextMatrix(r, 14) = rs!家庭地址
        End If
        r = r + 1
        rs.MoveNext
        FrmShowAllRen.Label4.Caption = "正在加载数据：" & i & " " & "/ " & t
        DoEvents
    Next i
    FrmShowAllRen.Label1.Caption = sqlstr
    FrmShowAllRen.Frame1.Width = FrmShowAllRen.Label1.Width + 300
    FrmShowAllRen.Caption = "联系人列表 （共 " & rs.RecordCount & " 个）"
    FrmShowAllRen.Label4.Caption = ""
    FrmShowAllRen.Enabled = True
    Exit Sub
showallrenerror:
    MsgBox "错误：" & Err.Number & "。（" & Err.Description & "）。", vbInformation, "错误"
End Sub
Public Sub ShowAllUrls(sqlstr As String)
On Error GoTo loaderror
        Form12.Caption = "正在加载网址数据库 ..."
        Form12.Enabled = False

    Dim db As Database
    Dim rs As Recordset
    Set db = OpenDatabase(MdbPath)
    Set rs = db.OpenRecordset(sqlstr)
    Form12.MSFlexGrid1.Clear
    Form12.MSFlexGrid1.Cols = 9
    Form12.MSFlexGrid1.TextMatrix(0, 0) = "ID"
    Form12.MSFlexGrid1.TextMatrix(0, 1) = "网站名称"
    Form12.MSFlexGrid1.TextMatrix(0, 2) = "助记码"
    Form12.MSFlexGrid1.TextMatrix(0, 3) = "网络地址"
    Form12.MSFlexGrid1.TextMatrix(0, 4) = "所属类别"
    Form12.MSFlexGrid1.TextMatrix(0, 5) = "网站性质"
    Form12.MSFlexGrid1.TextMatrix(0, 6) = "登录用户名"
    Form12.MSFlexGrid1.TextMatrix(0, 7) = "登录密码"
    Form12.MSFlexGrid1.TextMatrix(0, 8) = "网站摘要"
    Form12.MSFlexGrid1.ColWidth(0) = 500
    If rs.RecordCount > 0 Then
        rs.MoveLast
        rs.MoveFirst
    End If
    Form12.MSFlexGrid1.Rows = rs.RecordCount + 1
    If rs.RecordCount > 0 Then
        Dim i As Integer
        For i = 1 To rs.RecordCount
            Form12.MSFlexGrid1.TextMatrix(i, 0) = rs!id
            Form12.MSFlexGrid1.TextMatrix(i, 1) = rs!网址名称
            If Len(Trim(rs!网址名称)) > 13 Then
                Form12.MSFlexGrid1.TextMatrix(i, 1) = Left(Trim(rs!网址名称), 15) & " ..."
            End If
            Form12.MSFlexGrid1.TextMatrix(i, 2) = rs!助记码
            Form12.MSFlexGrid1.TextMatrix(i, 3) = rs!网络地址
            Form12.MSFlexGrid1.TextMatrix(i, 4) = rs!所属类别
            Form12.MSFlexGrid1.TextMatrix(i, 5) = rs!网站性质
            If rs!所属类别 = 0 Then
                Form12.MSFlexGrid1.TextMatrix(i, 4) = "(无类别)"
            Else
                Dim Db2 As Database
                Dim rss As Recordset
                Set Db2 = OpenDatabase(MdbPath)
                Set rss = Db2.OpenRecordset("select * from urlleibie where id =" & rs!所属类别)
                If rss!所属类别 <> 0 Then
                    Form12.MSFlexGrid1.TextMatrix(i, 4) = rss!所属类别
                Else
                    Form12.MSFlexGrid1.TextMatrix(i, 4) = "(无类别)"
                End If
                rss.Close
                Db2.Close
                Set rss = Nothing
                Set Db2 = Nothing
            End If
            If rs!网站性质 = 0 Then
                Form12.MSFlexGrid1.TextMatrix(i, 5) = "(无类别)"
            Else
                Dim db22 As Database
                Dim rss2 As Recordset
                Set db22 = OpenDatabase(MdbPath)
                Set rss2 = db22.OpenRecordset("select * from urlxingzhi where id =" & rs!网站性质)
                If rss2!网站性质 <> 0 Then
                    Form12.MSFlexGrid1.TextMatrix(i, 5) = rss2!网站性质
                Else
                    Form12.MSFlexGrid1.TextMatrix(i, 5) = "(无类别)"
                End If
                rss2.Close
                db22.Close
                Set rss2 = Nothing
                Set db22 = Nothing
            End If
            Form12.MSFlexGrid1.TextMatrix(i, 6) = rs!登录用户名
            Form12.MSFlexGrid1.TextMatrix(i, 7) = rs!登录密码
            Form12.MSFlexGrid1.TextMatrix(i, 8) = rs!网站摘要
            rs.MoveNext
        Next i
        Form12.Label1.Caption = sqlstr
        Form12.Frame1.Width = Form12.Label1.Width + 300
    End If
        Form12.Caption = "网址管理中心" & " （" & rs.RecordCount & "）"
        Form12.Enabled = True
        Exit Sub
loaderror:
    MsgBox Err.Number & vbCrLf & Err.Description, vbCritical, "加载网址数据出错"
        Form12.Caption = "网址管理中心"
        Form12.Enabled = True
End Sub
Public Sub allshow(sqlstr As String)
On Error GoTo allshowerr
    If Trim(sqlstr) = "" Then
        Exit Sub
    End If
    Form2.MSFlexGrid1.ColWidth(0) = 500
    Form2.MSFlexGrid1.Clear
    Form2.Enabled = False
    Form2.Caption = "正在读取商家列表的数据库，请稍候 ... "
    Dim rsts As Integer
    Dim db As Database
    Dim rs As Recordset
    Set db = OpenDatabase(MdbPath)
    Set rs = db.OpenRecordset(sqlstr)
    If rs.RecordCount = 0 Then
        Form2.MSFlexGrid1.Rows = 2
        Form2.MSFlexGrid1.TextMatrix(1, 1) = "没有任何资料可以显示。"
    End If
    If rs.RecordCount > 0 Then
        rs.MoveLast
        rs.MoveFirst
        rsts = rs.RecordCount
    End If
    Form2.MSFlexGrid1.Rows = rsts + 1
    If rsts >= 1 Then
        Form2.MSFlexGrid1.Clear
        Form2.MSFlexGrid1.TextMatrix(0, 0) = "ID"
        Form2.MSFlexGrid1.TextMatrix(0, 1) = "企业名称"
        Form2.MSFlexGrid1.TextMatrix(0, 2) = "企业助记码"
        Form2.MSFlexGrid1.TextMatrix(0, 3) = "企业性质"
        Form2.MSFlexGrid1.TextMatrix(0, 4) = "企业行业"
        Form2.MSFlexGrid1.TextMatrix(0, 5) = "企业地址"
        Form2.MSFlexGrid1.TextMatrix(0, 6) = "邮政编码"
        Form2.MSFlexGrid1.TextMatrix(0, 7) = "企业电话"
        Form2.MSFlexGrid1.TextMatrix(0, 8) = "企业传真"
        Form2.MSFlexGrid1.TextMatrix(0, 9) = "企业网址"
        Form2.MSFlexGrid1.TextMatrix(0, 10) = "经营范围"
        Form2.MSFlexGrid1.TextMatrix(0, 11) = "代表法人"
        Form2.MSFlexGrid1.RowHeight(0) = 300
        Form2.MSFlexGrid1.ColAlignment(0) = 4
        Form2.MSFlexGrid1.ColWidth(1) = 2700
        Form2.MSFlexGrid1.ColWidth(2) = 1
        Form2.MSFlexGrid1.ColWidth(3) = 1000
        Form2.MSFlexGrid1.ColWidth(4) = 1000
        Form2.MSFlexGrid1.ColWidth(5) = 3000
        Form2.MSFlexGrid1.ColWidth(7) = 1500
        Form2.MSFlexGrid1.ColWidth(6) = 800
        Dim i As Integer
        i = rsts
        Dim s As Integer
        Form2.Label4.Caption = "正在读取数据库 ( 1 / " & rs.RecordCount & ")"
        For s = 1 To i
            If IsNull(rs!id) = False Then
            Form2.MSFlexGrid1.TextMatrix(s, 0) = rs!id
            Else
                MsgBox "程序初步认定数据库应经出现了错误，而且极有可能数据库出现了结构上的错误，本次加载数据的操作失败！", vbCritical, "数据库结构中自动编号值为 Null ！"
                rs.Close
                Set rs = Nothing
                db.Close
                Set db = Nothing
                Exit Sub
            End If
            If IsNull(rs!企业名称) = False Then
                Form2.MSFlexGrid1.TextMatrix(s, 1) = rs!企业名称
            End If
            If IsNull(rs!企业助记码) = False Then
                Form2.MSFlexGrid1.TextMatrix(s, 2) = rs!企业助记码
            End If
            If IsNull(rs!企业性质) = False Then
                Form2.MSFlexGrid1.TextMatrix(s, 3) = rs!企业性质
                    'Dim xzdb As Database
                    'Dim xzrs As Recordset
                    'Set xzdb = OpenDatabase(MdbPath)
                    'Set xzrs = xzdb.OpenRecordset("select * from xingzhi where id=" & Val(rs!企业性质))
                    'If xzrs.RecordCount = 0 Then
                    '    Form2.MSFlexGrid1.TextMatrix(s, 3) = "(非法定义)"
                    'ElseIf xzrs.RecordCount = 1 Then
                    '    xzrs.MoveLast
                    '    xzrs.MoveFirst
                    'End If
                    'If xzrs.RecordCount > 1 Then
                    '    Form2.MSFlexGrid1.TextMatrix(s, 3) = "(非法定义)"
                    'ElseIf xzrs.RecordCount = 1 Then
                    '    Form2.MSFlexGrid1.TextMatrix(s, 3) = xzrs!性质名称
                    'End If
                    'xzrs.Close:    xzdb.Close:    Set xzrs = Nothing:    Set xzdb = Nothing
            End If
            If IsNull(rs!企业行业) = False Then
                Form2.MSFlexGrid1.TextMatrix(s, 4) = rs!企业行业
                    'Dim hydb As Database
                    'Dim hyrs As Recordset
                    'Set hydb = OpenDatabase(MdbPath)
                    'Set hyrs = hydb.OpenRecordset("select * from hangye where id=" & Val(rs!企业行业))
                    'If hyrs.RecordCount = 0 Then
                    '    Form2.MSFlexGrid1.TextMatrix(s, 4) = "(非法定义)"
                    'ElseIf hyrs.RecordCount = 1 Then
                    '    hyrs.MoveLast
                    '    hyrs.MoveFirst
                    'End If
                    'If hyrs.RecordCount > 1 Then
                    '    Form2.MSFlexGrid1.TextMatrix(s, 4) = "(非法定义)"
                    'ElseIf hyrs.RecordCount = 1 Then
                    '    Form2.MSFlexGrid1.TextMatrix(s, 4) = hyrs!行业名称
                    'End If
                    'hyrs.Close:    hydb.Close:    Set hyrs = Nothing:    Set hydb = Nothing
            End If
            If IsNull(rs!企业地址) = False Then
                Form2.MSFlexGrid1.TextMatrix(s, 5) = rs!企业地址
            End If
            If IsNull(rs!邮政编码) = False Then
                Form2.MSFlexGrid1.TextMatrix(s, 6) = rs!邮政编码
            End If
            If IsNull(rs!企业电话) = False Then
                Form2.MSFlexGrid1.TextMatrix(s, 7) = rs!企业电话
            End If
            If IsNull(rs!企业传真) = False Then
                Form2.MSFlexGrid1.TextMatrix(s, 8) = rs!企业传真
            End If
            If IsNull(rs!企业网址) = False Then
                Form2.MSFlexGrid1.TextMatrix(s, 9) = rs!企业网址
            End If
            If IsNull(rs!经营范围) = False Then
                Form2.MSFlexGrid1.TextMatrix(s, 10) = rs!经营范围
            End If
            If IsNull(rs!法人代表) = False Then
                Form2.MSFlexGrid1.TextMatrix(s, 11) = rs!法人代表
            End If
            Form2.Label4.Caption = "正在读取数据库 ( " & s & " / " & rs.RecordCount & ")"
            rs.MoveNext
            DoEvents
        Next s
        Form2.Label4.Caption = ""
    End If
    Form2.Caption = "商家列表（" & rs.RecordCount & "）"
    Form2.Enabled = True
    rs.Close
    Set rs = Nothing
    db.Close
    Set db = Nothing
    If form2show = True Then
        Form2.Label1.Caption = sqlstr
        Form2.Frame1.Width = Form2.Label1.Width + 300
    End If
    Exit Sub
allshowerr:
If Err.Number <> 0 Then
    MsgBox Err.Number & "：" & Err.Description
    Form2.Enabled = True
End If
End Sub