main.frm

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

    End If
        
End Sub



Private Sub mruanjianshuoming_Click()

    Load frmAbout
    frmAbout.Show
End Sub

Private Sub Mshangcha_Click()
    If form8show = True Then
        Form8.SetFocus
    Else
        Load Form8
        Form8.Show
    End If
End Sub

Private Sub Mshangshan_Click()
    If form2show = False Then
        Load Form2
        Form2.Show
        Dim db As Database
        Dim rs As Recordset
        Set db = OpenDatabase(MdbPath)
        Set rs = db.OpenRecordset("select listnum from proset")
        Dim dbb As Database
        Dim rss As Recordset
        Set dbb = OpenDatabase(MdbPath)
        Set rss = dbb.OpenRecordset("select * from com")
        If rss.RecordCount > 0 Then
            rss.MoveLast
            rss.MoveFirst
        End If
        If IsNull(rs!ListNum) = True Then
            allshow ("select * from com order by id desc")
        ElseIf Val(rs!ListNum) = 0 Then
            allshow ("select * from com order by id desc")
        ElseIf Val(rs!ListNum) > 0 Then
            If rss.RecordCount < Val(rs!ListNum) Then
                allshow ("select * from com order by id desc")
            ElseIf rss.RecordCount >= Val(rs!ListNum) Then
                allshow ("select top " & Val(rs!ListNum) & " * from com order by id desc")
            End If
        End If
        rss.Close
        dbb.Close
        Set rss = Nothing
        Set dbb = Nothing
        rs.Close
        db.Close
        Set rs = Nothing
        Set db = Nothing
    Else
                If Form2.MSFlexGrid1.Rows = 1 Then Exit Sub

        If MsgBox("将要删除【" & Form2.MSFlexGrid1.TextMatrix(Form2.MSFlexGrid1.RowSel, 0) & "：" & Form2.MSFlexGrid1.TextMatrix(Form2.MSFlexGrid1.RowSel, 1) & " 】的资料，该操作将不可恢复，确定删除吗？另外需要说明的是如果这个单位已经产生了拜访记录，那么这个单位的资料将不再允许被删除，否则，会产生错误。", vbQuestion + vbYesNo + vbDefaultButton2, "即将删除商家资料和记录") = vbYes Then
            Dim db3 As Database
            Dim rs3 As Recordset
            Set db3 = OpenDatabase(MdbPath)
            Set rs3 = db3.OpenRecordset("select * from baifang where 企业ID号=" & Val(Form2.MSFlexGrid1.TextMatrix(Form2.MSFlexGrid1.RowSel, 0)))
            If rs3.RecordCount > 0 Then
                rs3.MoveLast
                rs3.MoveFirst
                MsgBox "已经产生了拜访记录，无法删除这个商家的资料，请删除该商家名下的拜访记录之后，再回来删除这个商家的资料。", vbCritical
                rs3.Close
                db3.Close
                Exit Sub
                Do Until rs3.EOF = True
                    rs3.Delete
                    rs3.MoveFirst
                Loop
            End If
            
            'rs3.Close
            Set rs3 = db3.OpenRecordset("select * from com where id=" & Val(Form2.MSFlexGrid1.TextMatrix(Form2.MSFlexGrid1.RowSel, 0)))

            If rs3.RecordCount = 1 Then
                rs3.Delete
                MsgBox "商家的资料已经删除完毕。", vbInformation, "删除完毕"
                allshow (Form2.Label1.Caption)
                SumNumber '求各个表中的记录数总和
            ElseIf rs3.RecordCount = 0 Then
                MsgBox "定位商家的时候出现了错误，请注意，没有找到相应的商家，RS的记录数应该为1的，但是返回值为0。", vbInformation, "返回值错误。"
                rs3.Close
                Set rs3 = Nothing
                db3.Close
                Set db3 = Nothing
                Exit Sub
            End If
        End If
    End If
End Sub

Private Sub Mshangtian_Click()
    Load Form1
    Form1.Show
End Sub

Private Sub Mshangxian_Click()
On Error GoTo ddd:
If form2show = True Then
    Form2.SetFocus
Else
    Load Form2
    Form2.Show

    Dim db As Database
    Dim rs As Recordset
    Set db = OpenDatabase(MdbPath)
    Set rs = db.OpenRecordset("select listnum from proset")
    Dim dbb As Database
    Dim rss As Recordset
    Set dbb = OpenDatabase(MdbPath)
    Set rss = dbb.OpenRecordset("select * from com")
    If rss.RecordCount > 0 Then
        rss.MoveLast
        rss.MoveFirst
    End If
    If IsNull(rs!ListNum) = True Then
        allshow ("select * from com order by id desc")
    ElseIf Val(rs!ListNum) = 0 Then
        allshow ("select * from com order by id desc")
    ElseIf Val(rs!ListNum) > 0 Then
        If rss.RecordCount < Val(rs!ListNum) Then
            allshow ("select * from com order by id desc")
        ElseIf rss.RecordCount >= Val(rs!ListNum) Then
            allshow ("select top " & Val(rs!ListNum) & " * from com order by id desc")
        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
    Exit Sub

ddd:
If Err.Number = 3078 Then
    MsgBox "数据库中没有找到指定的表，数据库结构已经发生改变。这个问题通常是由于数据库结构错误导致的，也可能是因为数据库的版本太低，没有和软件一起升级。", vbCritical
Else
    MsgBox Err.Number & "：" & Err.Description
End If
End Sub

Private Sub Mshangxiu_Click()
    If form2show = False Then
        Load Form2
        Form2.Show
        Dim db As Database
        Dim rs As Recordset
        Set db = OpenDatabase(MdbPath)
        Set rs = db.OpenRecordset("select listnum from proset")
        Dim dbb As Database
        Dim rss As Recordset
        Set dbb = OpenDatabase(MdbPath)
        Set rss = dbb.OpenRecordset("select * from com")
        If rss.RecordCount > 0 Then
            rss.MoveLast
            rss.MoveFirst
        End If
        If IsNull(rs!ListNum) = True Then
            allshow ("select * from com order by id desc")
        ElseIf Val(rs!ListNum) = 0 Then
            allshow ("select * from com order by id desc")
        ElseIf Val(rs!ListNum) > 0 Then
            If rss.RecordCount < Val(rs!ListNum) Then
                allshow ("select * from com order by id desc")
            ElseIf rss.RecordCount >= Val(rs!ListNum) Then
                allshow ("select top " & Val(rs!ListNum) & " * from com order by id desc")
            End If
        End If
        rss.Close
        dbb.Close
        Set rss = Nothing
        Set dbb = Nothing
        rs.Close
        db.Close
        Set rs = Nothing
        Set db = Nothing
    Else '如果商家资料列表窗体已经打开了.
        If Form2.MSFlexGrid1.Rows = 1 Then Exit Sub
        EditComInfo (Val((Form2.MSFlexGrid1.TextMatrix(Form2.MSFlexGrid1.RowSel, 0))))
    End If

End Sub

Private Sub mupdate_Click()
    Load Form19
    Form19.Show
End Sub

Private Sub murlsadd_Click()
    Load frmaddurls
    frmaddurls.Show

End Sub

Private Sub murlsdel_Click()
    If form12show = False Then
        Load Form12
        Form12.Show
        ShowAllUrls ("select * from urls order by id desc")
        Exit Sub
    Else
        If Form12.MSFlexGrid1.RowSel = 0 Then
            Exit Sub
        End If
        If MsgBox("将要删除【" & Form12.MSFlexGrid1.TextMatrix(Form12.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 urls where id=" & Val(Form12.MSFlexGrid1.TextMatrix(Form12.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, "完毕"
                    ShowAllUrls (Form12.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 murlsedit_Click()
If form12show = False Then
    Load Form12
    Form12.Show
    ShowAllUrls ("select * from urls order by id desc")
    Exit Sub
End If
If Form12.MSFlexGrid1.RowSel = 0 Then Exit Sub
    Dim db As Database
    Dim rs As Recordset
    Set db = OpenDatabase(MdbPath)
    Set rs = db.OpenRecordset("select * from urls where id =" & Form12.MSFlexGrid1.TextMatrix(Form12.MSFlexGrid1.RowSel, 0))
    If rs.RecordCount = 0 Then
        MsgBox "软件在定位目标网址的时候，出现了错误，错误的原因是没有找到目标的资料。", vbCritical, "目标没有找到，错误"
        Exit Sub
        rs.Close
        db.Close
        Set rs = Nothing
        Set db = Nothing
    ElseIf rs.RecordCount > 0 Then
        rs.MoveLast
        rs.MoveFirst
        If rs.RecordCount > 1 Then
            MsgBox "软件在定位目标网址的时候，出现了错误，错误的原因是找到多个可供修改的目标的资料。无法精确定位。", vbCritical, "目标定位错误"
            Exit Sub
            rs.Close
            db.Close
            Set rs = Nothing
            Set db = Nothing
        ElseIf rs.RecordCount = 1 Then
            FrmUrlsEdit.Text11.Text = rs!id
            FrmUrlsEdit.Text1.Text = rs!网址名称
            FrmUrlsEdit.Text2.Text = rs!助记码
            FrmUrlsEdit.Text3.Text = rs!网络地址
            FrmUrlsEdit.Text4.Text = rs!登录用户名
            FrmUrlsEdit.Text5.Text = rs!登录密码
            FrmUrlsEdit.Text6.Text = rs!网站摘要
            FrmUrlsEdit.Text10.Text = rs!所属类别
                Dim lbdb As Database
                Dim lbrs As Recordset
                Set lbdb = OpenDatabase(MdbPath)
                Set lbrs = lbdb.OpenRecordset("select * from urlleibie where id =" & rs!所属类别)
                If lbrs.RecordCount = 0 Then
                    FrmUrlsEdit.Text8.Text = "(查找类别失败)"
                ElseIf lbrs.RecordCount > 0 Then
                    lbrs.MoveLast
                    lbrs.MoveFirst
                    If lbrs.RecordCount = 1 Then
                        FrmUrlsEdit.Text8.Text = lbrs!所属类别
                    Else
                        FrmUrlsEdit.Text8.Text = "(查找类别失败)"
                    End If
                End If
                lbrs.Close
                Set lbrs = Nothing
                lbdb.Close
                Set lbdb = Nothing
            FrmUrlsEdit.Text9.Text = rs!网站性质
                Dim xzdb As Database
                Dim xzrs As Recordset
                Set xzdb = OpenDatabase(MdbPath)
                Set xzrs = xzdb.OpenRecordset("select * from urlxingzhi where id =" & rs!网站性质)
                If xzrs.RecordCount = 0 Then
                    FrmUrlsEdit.Text7.Text = "(查找性质失败)"
                ElseIf xzrs.RecordCount > 0 Then
                    xzrs.MoveLast
                    xzrs.MoveFirst
                    If xzrs.RecordCount = 1 Then
                        FrmUrlsEdit.Text7.Text = xzrs!网站性质
                    Else
                        FrmUrlsEdit.Text7.Text = "(查找性质失败)"
                    End If
                End If
                xzrs.Close
                Set xzrs = Nothing
                xzdb.Close
            rs.Close
            db.Close
            Set rs = Nothing
            Set db = Nothing
        End If
    End If

End Sub

Private Sub murlsshow_Click()
    If form12show = True Then
        Form12.SetFocus
    Else
        Load Form12
        Form12.Show
    End If
End Sub

Private Sub opencdrom_Click()
Dim retValue As Long
retValue = mciSendString("set CDAudio door open", "", 127, 0)

End Sub

Private Sub ShowThisBaifang_Click()
    If Val(Form2.MSFlexGrid1.TextMatrix(Form2.MSFlexGrid1.RowSel, 0)) = 0 Then
        Exit Sub
    Else
        ShowComBaifang Val(Form2.MSFlexGrid1.TextMatrix(Form2.MSFlexGrid1.RowSel, 0))
    End If
End Sub

Private Sub sqlyuju_Click()
    Load Form11
    Form11.Show
End Sub

Private Sub ToExcel_Click()
    Load Form17
    Form17.Show
    Me.Enabled = False
End Sub

Private Sub 清空数据库_Click()
    Load FrmClsMDB
    FrmClsMDB.Show
End Sub