frm_outcustomer_riches.frm

一个公司的客户财产管理系统vb源码

              key = Trim(Rs_Area.Fields("客户编码"))
              text = "(" & Trim(Rs_Area.Fields("客户编码")) & ")" & Trim(Rs_Area.Fields("客户名称"))
              Set node2 = Tvw_Customer.Nodes.Add(node2.Index, tvwLast, key, text, 1)
            End If
            '不同地区不同客户
            If AreaCode <> Trim(Rs_Area.Fields("地区编码")) And CustomerCode <> Trim(Rs_Area.Fields("客户编码")) Then
              AreaCode = Trim(Rs_Area.Fields("地区编码"))
              CustomerCode = Trim(Rs_Area.Fields("客户编码"))
              key = Trim(Rs_Area.Fields("地区编码"))
              text = "(" & Trim(Rs_Area.Fields("地区编码")) & ")" & Trim(Rs_Area.Fields("地区名称"))
              Set node1 = Tvw_Customer.Nodes.Add(, , key, text, 1)
              
              key = Trim(Rs_Area.Fields("客户编码"))
              text = "(" & Trim(Rs_Area.Fields("客户编码")) & ")" & Trim(Rs_Area.Fields("客户名称"))
              Set node2 = Tvw_Customer.Nodes.Add(node1.Index, tvwChild, key, text, 1)
            End If
          End If
          Rs_Area.MoveNext
    Loop
    
  Else
     MsgBox "记录为空!"
  End If
  Rs_Area.Close
  Cn_Area.Close
  
Exit Sub
err:
  MsgBox err.Description, vbCritical
End Sub

'Private Sub Excel_Enter()
'On Error GoTo xxx
'    CommonDialog1.DialogTitle = "请选择你要打开的EXCEL表格"
'    CommonDialog1.Filter = "EXCEL表格文件 (*.xls)|*.xls"
'    CommonDialog1.InitDir = "D:\EXCEL\客户财产\"
'    CommonDialog1.ShowOpen
'    FileName1 = CommonDialog1.FileName
'    If FileName1 <> "" Then
'        Length1 = Len(FileName1)
'        FileName2 = Left(FileName1, Length1 - 3) + "bz"
''        If filename1 <> "" Then
'        If Dir(FileName2) = "" Then                          '判断EXCEL是否打开
'          Set xlApp = CreateObject("Excel.Application")      '创建EXCEL应用类
'          xlApp.Visible = True                               '设置EXCEL可见
'          Set xlBook = xlApp.Workbooks.Open(FileName1)       '("D:\temp\bb.xls") '打开EXCEL工作簿
'          Set xlsheet = xlBook.Worksheets("客户财产")                 '打开EXCEL工作表
'          xlsheet.Activate                                   '激活工作表
'
''          cmdenter.Enabled = True
'
'        Else
'          MsgBox "Microsoft Excel 已经打开了关闭!" + Chr(13) + "请先关闭将所有EXCEL!"
'        End If
'    Else
'      MsgBox "操作被取消!", vbOKOnly + vbInformation, "提示信息"
'    End If
'xxx:
'   Exit Sub
''    Shell
'   'CommonDialog1.ShowOpen
'
'
'End Sub

Private Sub Form_Activate()
  Call DGrid_Width_Set(Frm_OutCustomer_Riches)
End Sub

Private Sub Form_Load()
On Error GoTo err
  Me.StatusBar1.Panels(3).text = ("操作员： " + OperatorName)
  Call Tree_Change
  Set Cn_OutCR = New ADODB.Connection
  Cn_OutCR.Open Cs
  Set Rs_OutCR = New ADODB.Recordset
  Rs_OutCR.Open "select * from OutCustomer_Riches order by 节目名称,母盘号码", Cn_OutCR, adOpenKeyset, adLockOptimistic, adCmdText 'adOpenKeyset, adLockOptimistic, adCmdText
  Set TDBGrid_CusRiches.DataSource = Rs_OutCR
  
  Call DGrid_Width_Set(Frm_OutCustomer_Riches)
  
  Me.StatusBar1.Panels(7).text = "记录总数： " & Str(Rs_OutCR.RecordCount)
  
'  If OperatorDepartment = "品质部-IQC" Then
'    Me.Toolbar1.Buttons(2).Enabled = False
'    Me.Toolbar1.Buttons(3).Enabled = False
'    Me.Toolbar1.Buttons(4).Enabled = False
''    Me.Toolbar1.Buttons(6).Enabled = False
''    Me.Toolbar1.Buttons(7).Enabled = False
'    If OperatorLevel <= 4 Then Me.Toolbar1.Buttons(8).Enabled = True
'  ElseIf OperatorDepartment = "生产部-统计" Then
'    Me.Toolbar1.Buttons(2).Enabled = False
'    Me.Toolbar1.Buttons(3).Enabled = False
'    Me.Toolbar1.Buttons(4).Enabled = False
''    Me.Toolbar1.Buttons(6).Enabled = False
''    Me.Toolbar1.Buttons(7).Enabled = False
'    If OperatorLevel <= 4 Then Me.Toolbar1.Buttons(8).Enabled = True
'  ElseIf OperatorDepartment = "营销部" Then
'    Me.Toolbar1.Buttons(2).Enabled = True
'    Me.Toolbar1.Buttons(3).Enabled = True
'    Me.Toolbar1.Buttons(4).Enabled = True
''    Me.Toolbar1.Buttons(6).Enabled = False
''    Me.Toolbar1.Buttons(7).Enabled = False
'    If OperatorLevel <= 4 Then
'      Me.Toolbar1.Buttons(3).Enabled = True
'      Me.Toolbar1.Buttons(8).Enabled = True
'    End If
'  End If

Exit Sub
err:
  MsgBox err.Description, vbCritical
End Sub

Private Sub Form_Unload(Cancel As Integer)
On Error GoTo err

    Set Me.TDBGrid_CusRiches.DataSource = Nothing
    Rs_OutCR.Close
    Cn_OutCR.Close
    
    '将变量置位
    YN_Area_Customer_Add = False
    YN_Area_Customer_Rename = False
    YN_Customer_Riches_Add = False
    YN_Customer_Riches_Repair = False
    YN_Customer_Riches_View = False

    AreaCustomer_Key = ""
    AreaCustomer_Text = ""
    Str_AreaCode = ""
    Str_AreaName = ""
    Str_CustomerCode = ""
    Str_CustomerName = ""
    StrCondition = ""
    StrField = ""
Exit Sub
err:
   MsgBox err.Description, vbCritical
End Sub
'
'Private Sub Mnu_Add_Click()
'On Error GoTo err:
'    YN_Area_Customer_Add = True
'    YN_Area_Customer_Rename = False
'    Load Frm_Area_Customer_Edit
'    Frm_Area_Customer_Edit.Show vbModal
'
'Exit Sub
'err:
'   MsgBox err.Description, vbCritical
'End Sub

'Private Sub Mnu_Del_Click()
'On Error GoTo err
'    '如果删除了地区
'    If Len(AreaCustomer_Key) = 2 Then
'      If MsgBox("此操作将会同时删除此地区的所有客户和其所有财产(节目源)!" + Chr(13) + "你确定要删除此地区吗?", vbYesNo + vbQuestion, "提示信息") = vbYes Then
'        '将客户财产表删除
'        Set Cn = New ADODB.Connection
'        Cn.Open Cs
'        Set Rs = New ADODB.Recordset
'        Rs.Open "select * from Customer_Riches where 内编码 like '%'+ '" & Left(AreaCustomer_Key, 2) & "'+'%' order by 内编码", Cn, adOpenKeyset, adLockOptimistic, adCmdText
'        If Rs.RecordCount > 0 Then '对地区代码/地区名/客户代码/赋值
'          Rs.MoveFirst
'          Do While Rs.EOF = False
'            Rs.Delete
'            Rs.Update
'            Rs.MoveNext
'          Loop
'        End If
'        Rs.Close
'        Cn.Close
'
'        '将此删除地区添加到删除表中
'        Set Cn = New ADODB.Connection
'        Cn.Open Cs
'        Set Rs = New ADODB.Recordset
'        Rs.Open "select * from Area_Customer_Delete", Cn, adOpenKeyset, adLockOptimistic, adCmdText
'        If Rs.RecordCount <> 0 Then
'          Rs.MoveLast
'          Rs.AddNew
'          Rs.Fields("删除时间") = Now
'          Rs.Fields("删除操作员") = OperatorName
'          Rs.Fields("地区编码") = AreaCustomer_Key
'          Rs.Fields("地区名称") = AreaCustomer_Text
'          Rs.Update
'        Else
'          Rs.AddNew
'          Rs.Fields("删除时间") = Now
'          Rs.Fields("删除操作员") = OperatorName
'          Rs.Fields("地区编码") = AreaCustomer_Key
'          Rs.Fields("地区名称") = AreaCustomer_Text
'          Rs.Update
'        End If
'        Rs.Close
'        Cn.Close
'
'        '将地区客户表删除
'        Set Cn = New ADODB.Connection
'        Cn.Open Cs
'        Set Rs = New ADODB.Recordset
'        Rs.Open "select * from Area_Customer where 地区编码 = '" & Left(AreaCustomer_Key, 2) & "' order by 客户编码", Cn, adOpenKeyset, adLockOptimistic, adCmdText
'        If Rs.RecordCount > 0 Then '对地区代码/地区名/客户代码/赋值
'          Rs.MoveFirst
'          Do While Rs.EOF = False
'            Rs.Delete
'            Rs.MoveNext
'          Loop
'        End If
'        Rs.Close
'        Cn.Close
'        Me.Tvw_Customer.Nodes.Clear
'        Call Tree_Change
''        MsgBox "地区删除成功!"
'      End If
'
'    End If
'
'    '如果删除了客户
'    If Len(AreaCustomer_Key) = 5 Then
'      If MsgBox("此操作将会同时删除此客户的所有财产(节目源)!" + Chr(13) + "你确定要删除此客户吗?", vbYesNo + vbQuestion, "提示信息") = vbYes Then
'
'        '将此删除客户添加到删除表中
'        Set Cn = New ADODB.Connection
'        Cn.Open Cs
'        Set Rs = New ADODB.Recordset
'        Rs.Open "select * from Area_Customer where 客户编码 like '%'+ '" & Left(AreaCustomer_Key, 5) & "'+'%' order by 客户编码", Cn, adOpenKeyset, adLockOptimistic, adCmdText
'        If Rs.RecordCount > 0 Then '对地区代码/地区名/客户代码/赋值
'          Rs.MoveFirst
'          Set Cn_Common = New ADODB.Connection
'          Cn_Common.Open Cs
'          Set Rs_Common = New ADODB.Recordset
'          Rs_Common.Open "select * from Area_Customer_Delete", Cn_Common, adOpenKeyset, adLockOptimistic, adCmdText
'          If Rs_Common.RecordCount <> 0 Then
'            Rs_Common.MoveLast
'            Rs_Common.AddNew
'            Rs_Common.Fields("删除时间") = Now
'            Rs_Common.Fields("删除操作员") = OperatorName
'            Rs_Common.Fields("地区编码") = Rs.Fields("地区编码")
'            Rs_Common.Fields("地区名称") = Rs.Fields("地区名称")
'            Rs_Common.Fields("客户编码") = Rs.Fields("客户编码")
'            Rs_Common.Fields("客户名称") = Rs.Fields("客户名称")
'            Rs_Common.Update
'          Else
'            Rs_Common.AddNew
'            Rs_Common.Fields("删除时间") = Now
'            Rs_Common.Fields("删除操作员") = OperatorName
'            Rs_Common.Fields("地区编码") = Rs.Fields("地区编码")
'            Rs_Common.Fields("地区名称") = Rs.Fields("地区名称")
'            Rs_Common.Fields("客户编码") = Rs.Fields("客户编码")
'            Rs_Common.Fields("客户名称") = Rs.Fields("客户名称")
'            Rs_Common.Update
'          End If
'          Rs_Common.Close
'          Cn_Common.Close
'        End If
'        Rs.Close
'        Cn.Close
'
'        '将客户财产表删除
'        Set Cn = New ADODB.Connection
'        Cn.Open Cs
'        Set Rs = New ADODB.Recordset