frmbaifangedit.frm

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

         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
   Begin VB.Label Label2 
      Alignment       =   2  'Center
      BorderStyle     =   1  'Fixed Single
      Height          =   210
      Left            =   3270
      TabIndex        =   15
      Top             =   4530
      Visible         =   0   'False
      Width           =   675
   End
End
Attribute VB_Name = "FrmBaiFangEdit"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'****************************************************************************
'人人为我，我为人人
'枕善居收藏整理
'发布日期：2007/12/24
'描    述：商务名片及客户资料管理系统 Ver 1.73
'网    站：http://www.Mndsoft.com/  (VB6源码博客)
'网    站：http://www.VbDnet.com/   (VB.NET源码博客,主要基于.NET2005)
'e-mail  ：[e-mail]
'e-mail  ：[e-mail]
'OICQ    ：88382850
'          如果您有新的好的代码别忘记给枕善居哦!
'****************************************************************************
Option Explicit

Private Sub Command1_Click()
    'MsgBox Val(Me.Label2.Caption)
    If Len(Trim(Text2.Text)) > 700 Then
        MsgBox "拜访记录摘要文字内容过长，请保持在700字范围之内。", vbInformation, "文字内容过长"
        Text2.SetFocus
        Exit Sub
    End If

    Dim db As Database
    Dim rs As Recordset
    Set db = OpenDatabase(MdbPath)
    Set rs = db.OpenRecordset("select * from baifang where id=" & Val(Trim(Text3.Text)))
    If rs.RecordCount = 0 Then
        MsgBox "当程序读取拜访记录的自动系统编号的时候，出现了错误，按照这个编号从数据库中返回空的记录集。", vbInformation, "定位错误"
        rs.Close
        db.Close
        Set rs = Nothing
        Set db = Nothing
        Exit Sub
    End If
    If rs!企业ID号 <> Me.Label2.Caption Then
        MsgBox "从数据库中读取的所属企业的ID号和系统返回的企业的ID号不一致，程序运行出现了错误，为了安全，程序将不保存这个修改后的资料。", vbInformation, "两个ID号不一致!"
        rs.Close
        db.Close
        Set rs = Nothing
        Set db = Nothing
        Exit Sub
    End If
    If Val(Me.Label2.Caption) = 0 Then
        MsgBox "程序读取所属企业的id号的时候,读取失败,返回值为空,或转化为数字的结果为零,本记录无法保存到数据库,尝试重新运行程序或还原最近的数据库备份.", vbInformation, "保存失败"
        rs.Close
        db.Close
        Set rs = Nothing
        Set db = Nothing
        Exit Sub
    End If
    If Trim(Me.Combo1.Text) = "" Or Trim(Me.Combo2.Text) = "" Or Trim(Text2.Text) = "" Then
        MsgBox "受访人和拜访人都不得为空,拜访资料也不得为空,请检查各项资料是否完整.", vbInformation, "资料不完整"
        rs.Close
        db.Close
        Set rs = Nothing
        Set db = Nothing
        Exit Sub
    End If
    rs.Edit
        rs!拜访人 = Trim(Me.Combo2.Text)
        rs!受访人 = Trim(Me.Combo1.Text)
        rs!拜访时间 = Me.DTPicker1.Value
        rs!内容 = Trim(Me.Text2.Text)
    rs.Update
    MsgBox "保存资料的操作成功完成。", vbInformation, "保存完毕"
    rs.Close
    db.Close
    Set rs = Nothing
    Set db = Nothing
    If AllBaiFangShow = True Then
        AllBaiFang.MSFlexGrid1.Clear
        ShowAllBaiFang (AllBaiFang.Label3.Caption)
    End If
    DoEvents
    Unload Me
End Sub

Private Sub Command2_Click()
    If form13show = True Then
        Form13.SetFocus
    Else
        Load Form13
        Form13.Show
    End If
        Form13.Frame3.Visible = True
        Form13.Label5.Caption = "正在准备读取数据库 ... "
        If Val(Label2.Caption) = 0 Then
            MsgBox "定位所属商家的ID号的时候错误：传递到该窗体上的企业ID号码错误，取值失败！", vbInformation, "参数传递失败"
        Exit Sub
        End If
        Form13.Label5.Caption = "正在打开数据库 ... "
        Dim db As Database
        Dim rs As Recordset
        Set db = OpenDatabase(MdbPath)
        Set rs = db.OpenRecordset("select * from baifang where 企业ID号 =" & Trim(Label2.Caption) & " order by id desc")
        If rs.RecordCount > 0 Then  '''''''''''''''''''''''''''''''''''这段代码为循环显示拜访记录到列表中。''''''''''''''''''
            Dim i As Integer
            Form13.Label5.Caption = "数据库已经打开，正在读取数据 ... "
            Form13.MSFlexGrid1.Cols = 5
            Form13.Text7.Text = Val(Trim(Label2.Caption))
            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 =" & Trim(Label2.Caption) & " 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 = 1 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!法人代表
            End If
        ElseIf rs.RecordCount > 1 Then
            MsgBox "数据出现了致命的错误，可能数据库已经紊乱，请立即和软件作者联系。软件在读取商家的信息的时候出现了错误：返回的商家集合有多个商家！", vbInformation, "数据处理错误"
            rs.Close
            Set rs = Nothing
            db.Close
            Set db = Nothing
            Exit Sub
        End If
        rs.Close
        Set rs = Nothing
        db.Close
        Set db = Nothing
        Form13.Label5.Caption = "数据库加载完毕。"
        Form13.Frame3.Width = Form13.Label5.Width + 250
        Form13.Text5.Text = Form13.MSFlexGrid1.TextMatrix(Form13.MSFlexGrid1.RowSel, 4)
        If WeekName(Form13.MSFlexGrid1.TextMatrix(Form13.MSFlexGrid1.RowSel, 1)) <> "" Then
        Form13.Text6.Text = Form13.MSFlexGrid1.TextMatrix(Form13.MSFlexGrid1.RowSel, 1) & "  [" & WeekName(Form13.MSFlexGrid1.TextMatrix(Form13.MSFlexGrid1.RowSel, 1)) & "]"
        Else
        Form13.Text6.Text = Form13.MSFlexGrid1.TextMatrix(Form13.MSFlexGrid1.RowSel, 1)
        End If
End Sub

Private Sub Command3_Click()
    EditComInfo (Val(Me.Label2.Caption))
End Sub

Private Sub Form_Load()

    Me.Icon = MDIForm1.Icon
    Me.BackColor = FormBackColor: Me.Frame1.BackColor = Me.BackColor: Me.Frame2.BackColor = Me.BackColor
End Sub