client_dbchange.frm

小型客户管理系统

            Charset         =   134
            Weight          =   400
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ColumnCount     =   2
         BeginProperty Column00 
            DataField       =   ""
            Caption         =   ""
            BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED} 
               Type            =   0
               Format          =   ""
               HaveTrueFalseNull=   0
               FirstDayOfWeek  =   0
               FirstWeekOfYear =   0
               LCID            =   2052
               SubFormatType   =   0
            EndProperty
         EndProperty
         BeginProperty Column01 
            DataField       =   ""
            Caption         =   ""
            BeginProperty DataFormat {6D835690-900B-11D0-9484-00A0C91110ED} 
               Type            =   0
               Format          =   ""
               HaveTrueFalseNull=   0
               FirstDayOfWeek  =   0
               FirstWeekOfYear =   0
               LCID            =   2052
               SubFormatType   =   0
            EndProperty
         EndProperty
         SplitCount      =   1
         BeginProperty Split0 
            BeginProperty Column00 
            EndProperty
            BeginProperty Column01 
            EndProperty
         EndProperty
      End
      Begin VB.ComboBox User_ListIn 
         Height          =   300
         Left            =   120
         Style           =   2  'Dropdown List
         TabIndex        =   2
         Top             =   600
         Width           =   2295
      End
      Begin VB.Label Label1 
         Caption         =   "请选择需要转出的客户的用户"
         Height          =   255
         Left            =   120
         TabIndex        =   1
         Top             =   240
         Width           =   2415
      End
   End
End
Attribute VB_Name = "Client_DbChange"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private FinishCode As Integer '标识操作步骤
Private UserListRS As New ADODB.Recordset
Private TempClientRS As New ADODB.Recordset
Private I As Integer

Private Sub cmdAddAll_Click()

If List1.ListCount = 0 Then
   MsgBox "无可选数据", vbExclamation, "警告"
Else
   For I = 0 To List1.ListCount - 1
       List1.Selected(I) = True
       List2.AddItem List1.Text
   Next I
   List1.Clear
End If
End Sub

Private Sub cmdAddOne_Click()
If List1.ListCount = 0 Or List1.ListIndex = -1 Then
   MsgBox "未选或无可选数据", vbExclamation, "警告"
Else
   List2.AddItem List1.Text
   List1.RemoveItem (List1.ListIndex)
End If
End Sub

Private Sub cmdClose_Click()
Unload Me
End Sub

Private Sub cmdFinish_Click()
Dim Sqlstring As String
Dim TmpClientCodeRS As New ADODB.Recordset

If User_ListOut.Text = "" Then
   MsgBox "请选择需要转入数据的用户", vbExclamation, "警告"
   Exit Sub
End If

Label5.Visible = True
ProgressBar1.Visible = True
ProgressBar1.Value = 0
ProgressBar1.Max = List3.ListCount

For I = 0 To List3.ListCount - 1
    List3.Selected(I) = True
    Set TmpClientCodeRS = Nothing
    TmpClientCodeRS.Open "select * from Client_BASE where 客户名称='" & List3.Text & "'", MainDB, adOpenStatic, adLockOptimistic
    
    Sqlstring = "insert into Principal_Change (客户编号,原跟进人,移交时间,接受人,移交原因) values(" _
                      & TmpClientCodeRS!客户编号 & ",'" & User_ListIn.Text & "','" & Date & "','" & User_ListOut.Text & "','" & Yjyy.Text & "')"
    MainDB.Execute (Sqlstring)
    
    ProgressBar1.Value = ProgressBar1.Value + 1
Next I

Sqlstring = "update Client_BASE set 所属人员='" & User_ListOut.Text & "' where 所属人员='" & User_ListIn.Text & "'"
MainDB.Execute (Sqlstring)

MsgBox "成功转出所选数据", vbInformation, "信息提示"
Unload Me
End Sub

Private Sub cmdNext_Click()
FinishCode = FinishCode + 1
Call UserCommand
End Sub

Private Sub cmdPrevious_Click()
FinishCode = FinishCode - 1
Call UserCommand
End Sub

Private Sub cmdRemoveAll_Click()
If List2.ListCount = 0 Then
   MsgBox "无可选数据", vbExclamation, "警告"
Else
   For I = 0 To List2.ListCount - 1
       List2.Selected(I) = True
       List1.AddItem List2.Text
   Next I
   List2.Clear
End If
End Sub

Private Sub cmdRemoveOne_Click()
If List2.ListCount = 0 Or List2.ListIndex = -1 Then
   MsgBox "未选或无可选数据", vbExclamation, "警告"
Else
   List1.AddItem List2.Text
   MsgBox List2.ListIndex
   List2.RemoveItem (List2.ListIndex)
End If
End Sub

Private Sub Form_Load()
FinishCode = 1
Call UserCommand

Set UserListRS = Nothing
UserListRS.Open "select * from User_BASE", SysLogDB, adOpenStatic, adLockOptimistic
If UserListRS.RecordCount > 0 Then
   UserListRS.MoveFirst
   While Not UserListRS.EOF
         User_ListIn.AddItem UserListRS!用户名
         UserListRS.MoveNext
   Wend
End If

Set UserListRS = Nothing
UserListRS.Open "select * from User_BASE where 用户名<>'" & UserName & "'", SysLogDB, adOpenStatic, adLockOptimistic
If UserListRS.RecordCount > 0 Then
   UserListRS.MoveFirst
   While Not UserListRS.EOF
         User_ListOut.AddItem UserListRS!用户名
         UserListRS.MoveNext
   Wend
End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
MDIForm1.Enabled = True
End Sub

Private Sub List1_DblClick()
List2.AddItem List1.Text
List1.RemoveItem (List1.ListIndex)
End Sub

Private Sub List2_DblClick()
List1.AddItem List2.Text
List2.RemoveItem (List2.ListIndex)
End Sub

Private Sub User_ListIn_Click()
Set TempClientRS = Nothing
TempClientRS.Open "select 客户名称 from Client_BASE where 所属人员='" & User_ListIn.Text & "'", MainDB, adOpenStatic, adLockOptimistic
Set Adodc1.Recordset = TempClientRS

End Sub

Private Sub UserCommand()
Select Case FinishCode
       Case 1
          cmdPrevious.Enabled = False
          cmdNext.Enabled = True
          cmdFinish.Enabled = False
          Frm_First.Visible = True
          Frm_Second.Visible = False
          Frm_Third.Visible = False
       Case 2
          If User_ListIn.Text <> "" Then
             If TempClientRS.RecordCount <> 0 Then
                TempClientRS.MoveFirst
                List1.Clear
                List2.Clear
                List3.Clear
                While Not TempClientRS.EOF
                    List1.AddItem TempClientRS!客户名称
                    TempClientRS.MoveNext
                Wend
             End If
             cmdPrevious.Enabled = True
             cmdNext.Enabled = True
             cmdFinish.Enabled = False
             Frm_First.Visible = False
             Frm_Second.Visible = True
             Frm_Third.Visible = False
          Else
             MsgBox "请选择需要转出数据的用户", vbExclamation, "警告"
             FinishCode = FinishCode - 1
          End If
       Case 3
          If List2.ListCount <> 0 Then
             List3.Clear
             For I = 0 To List2.ListCount - 1
                 List2.Selected(I) = True
                 List3.AddItem List2.Text
             Next I

             cmdPrevious.Enabled = True
             cmdNext.Enabled = False
             cmdFinish.Enabled = True
             Frm_First.Visible = False
             Frm_Second.Visible = False
             Frm_Third.Visible = True
          Else
             MsgBox "请选择需要转出的数据", vbExclamation, "警告"
             FinishCode = FinishCode - 1
          End If
End Select
End Sub