📄 module1.bas

📁 考勤系统,智能判断刷卡异常,是一大型ERP系统的一个分支
💻 BAS
📖 第 1 页 / 共 3 页
字号:
    adoprimaryRS.Fields("dptname").Value = .Fields("bmmc").Value
    adoprimaryRS.Fields("ify").Value = 1     ''' .Fields("bmmc").Value
    adoprimaryRS.Update
    .MoveNext
    Loop
End With

    

                  strSQL = "select * from zgda_jbxxk"     '''天平
Set adoprimaryRS = db.adoprimaryRS(strSQL)
'                  strSQL = "select * from bmxxk"     '''天平
'Set adoPrimaryRS3 = db.adoPrimaryRS(strSQL)
With adoprimaryRS
    .MoveFirst
    Do While Not .EOF
      adoPrimaryRS2.Find "bmbh='" & .Fields("bmbh").Value & "'", 0, adSearchForward, adBookmarkFirst
  If Not adoPrimaryRS2.EOF Then
  .Fields("zgsg").Value = adoPrimaryRS2.Fields("xh").Value
  .Update
  End If
  .MoveNext
  Loop
  .MoveFirst
  
  End With
  
  
  
                 strSQL = "select zcbj,zggh,zgxm,jcsj,lzsj,bmmc,ylbj from zgda_jbxxk a,bmxxk b where a.bmbh=b.bmbh"     '''天平
         Set adoRS = db.adoprimaryRS(strSQL)

'Debug.Print strSQL
'Debug.Print adoRS.RecordCount


        'Redo:
        strSQL2 = "delete from emply2"
        mDB.ExecuteSQL strSQL2
        
        strSQL2 = "select * from emply2"
        Set adoPrimaryRS2 = mDB.adoprimaryRS(strSQL2)
                
                
        strSQL3 = "select * from emply"
        Set adoPrimaryRS3 = mDB.adoprimaryRS(strSQL3)
                
        With adoRS
            If .RecordCount = 0 Then Exit Sub


        .MoveFirst
            Do Until .EOF
'            If .Fields("zcbj").Value <> 0 Then
                adoPrimaryRS2.AddNew
                adoPrimaryRS2.Fields("ifin").Value = .Fields("zcbj").Value
                adoPrimaryRS2.Fields("partname").Value = .Fields("bmmc").Value
                adoPrimaryRS2.Fields("emplyid").Value = "00" & .Fields("zggh").Value
                adoPrimaryRS2.Fields("emplyname").Value = LeftB(.Fields("zgxm").Value, 8)
                adoPrimaryRS2.Fields("indate").Value = .Fields("jcsj").Value
                adoPrimaryRS2.Fields("outdate").Value = .Fields("lzsj").Value
                '    adoprimaryRS2.Fields("gangwei").Value = .Fields("gangwei").Value
                adoPrimaryRS2.Update
'            Else
'            'adoPrimaryRS3.Find "emplyid='" & "00" & .Fields("工号").Value & "'", 0, adSearchForward, adBookmarkFirst
'            adoPrimaryRS3.Filter = "emplyid='00" & .Fields("zggh").Value & "'"        ''', 0, adSearchForward, adBookmarkFirst
'            If adoPrimaryRS3.RecordCount Then
'            adoPrimaryRS3.Fields("dptid").Value = 2
''            adoPrimaryRS3.Fields("empbirthday").Value = .Fields("csny").Value
'          adoPrimaryRS3.Update
'            End If
'            End If
            
                .MoveNext
            Loop
'        adoPrimaryRS2.Update
'        adoPrimaryRS3.Update
       End With

                    

      

        strSQL = "select * from emply2 where emplyid not in (select emplyid from emply)"
        Set adoRS = mDB.adoprimaryRS(strSQL)


        Screen.MousePointer = 0

        If MsgBox("更新后合计人员——" & adoPrimaryRS2.RecordCount & "其中有" & adoRS.RecordCount & "为新进人员。现在加入吗？", vbYesNo, "NewAsia") = vbYes Then
            strSQL2 = "select top 10 * from emply"
            Set adoPrimaryRS2 = mDB.adoprimaryRS(strSQL2)
            If adoRS.RecordCount Then
                adoRS.MoveFirst
                Do While Not adoRS.EOF
                    With adoPrimaryRS2
                        .AddNew
                        .Fields("dptid").Value = 1
                        .Fields("emplyid").Value = adoRS.Fields("emplyid").Value
                        .Fields("emplyname").Value = adoRS.Fields("emplyname").Value
                        .Update
                    End With
                    adoRS.MoveNext
                Loop
                adoPrimaryRS2.MoveFirst
            End If
        End If

      
      
 
        strSQL = "select zcbj,zggh,zgxm,csny,jcsj,lzsj,zgsg,zgjc,zwbh,zgxb,ylbj from zgda_jbxxk "     '''天平
Set adoRS = db.adoprimaryRS(strSQL)
        strSQL3 = "select * from emply"
        Set adoPrimaryRS3 = mDB.adoprimaryRS(strSQL3)



'On Error Resume Next
On Error GoTo Err1
        With adoPrimaryRS3
'        MsgBox .RecordCount
            If .RecordCount Then
            .MoveFirst
            End If
            Do While Not .EOF
            adoRS.Find "zggh='" & Mid(.Fields("emplyid").Value, 3) & "'", 0, adSearchForward, adBookmarkFirst
            If Not adoRS.EOF Then
            .Fields("dptid").Value = adoRS.Fields("zgsg").Value
            .Fields("emplyname").Value = adoRS.Fields("zgxm").Value
            .Fields("empsex").Value = IIf(adoRS.Fields("zgxb").Value = "男", 1, 0)
            .Fields("empbirthday").Value = adoRS.Fields("csny").Value
            .Fields("serial").Value = adoRS.Fields("zgjc").Value
            .Fields("empcrdyn").Value = IIf(Len(adoRS.Fields("zgjc").Value) > 1, 1, 0)
            .Fields("duty").Value = Left(adoRS.Fields("zwbh").Value, 10)
            
            .Fields("zcbj").Value = adoRS.Fields("zcbj").Value
            
            .Update
            End If
            .MoveNext
            Loop
            If .RecordCount Then
            .MoveFirst
            End If
        End With
        
        
        
              
          
       ''''''''''////////////**********************///////////////////////
       Dim n As Integer
          strSQL = "select zcbj,zggh,zgxm,csny,jcsj,lzsj,zgsg,zgjc,zwbh,zgxb,ylbj from zgda_jbxxk where ylbj<>0"     '''天平
Set adoRS = db.adoprimaryRS(strSQL)
     
        'adoRS.Filter = "ylbj<>0"
        If adoRS.RecordCount Then
        With adoRS
            .MoveFirst
            Do While Not .EOF
            strSQL = "delete from emply2 where emplyid='00" & .Fields("zggh").Value & "'"
            'Debug.Print strSQL
            
            mDB.ExecuteSQL strSQL
            
            strSQL = "delete from emply where emplyid='00" & .Fields("zggh").Value & "'"
            mDB.ExecuteSQL strSQL
            n = n + 1
            
            .MoveNext
            Loop
            '''MsgBox .RecordCount & "条记录被删除。"
        End With
        
        
        End If
        
       ''''''''''////////////**********************///////////////////////
        
      
        
        
        
        
        
        
        
          MsgBox "更新OK！"
  
      
        End Select
    
  


        'Set db = Nothing
        'Set mDB = Nothing

    End If


    Set db = Nothing
    Set mDB = Nothing

    Exit Sub
Err1:
    Screen.MousePointer = 0
DisPlayErr Err

    Set db = Nothing
    Set mDB = Nothing


End Sub





Public Sub HLKaoQin_ManRefresh(ByVal Index As Integer, ByVal Server As String)
    On Error GoTo Err1
    Err.Clear
    Dim db As New mDB
    Dim mDB As New mDB

    Dim strSQL As String
    Dim adoRS As ADODB.Recordset
    Dim adoprimaryRS As ADODB.Recordset
    Dim strSQL2 As String
    Dim adoPrimaryRS2 As ADODB.Recordset
    Dim strSQL3 As String
    Dim adoPrimaryRS3 As ADODB.Recordset
    
    
    Dim adoRS_Depart As ADODB.Recordset
'    Dim adoRS_bmxx As ADODB.Recordset
'    Dim adoRS_jbxx As ADODB.Recordset
'    Dim adoRS_emply As ADODB.Recordset
'    Dim adoRS_emply2 As ADODB.Recordset



    If MsgBox("你真的要进行人员更新吗？", vbYesNo, "NewAsia") = vbYes Then
        Screen.MousePointer = 11




        Select Case Index
            Case 0

''  db.InitDB_SQL Server, "xinya", "reformer", "5148936"
'  db.InitDB_SQL Server, "rzerp_xyhn", "reformer", "5148936"
'
''  strSQL2 = "select * from bmxxk order by bmbh"
''  Set adoPrimaryRS2 = db.adoprimaryRS(strSQL2)
'
'
'
'
'
'mDB.InitDB_RY strconnDR
''  mDB.InitDB_SQL "tianping", "refor", "reformer", "5148936"
'
''  Dim i As Integer
''  Dim iLen As Integer
''  Dim s As String
''  Dim sTmp As String
''
''  adoPrimaryRS2.MoveFirst
''  For i = 2 To adoPrimaryRS2.RecordCount + 1
''  adoPrimaryRS2.Fields("xh").Value = i
''  adoPrimaryRS2.Update
''  adoPrimaryRS2.MoveNext
''  Next i
''
''  Set adoPrimaryRS3 = adoPrimaryRS2.Clone
''
''    adoPrimaryRS2.MoveFirst
''    For i = 0 To adoPrimaryRS2.RecordCount - 1
''    s = adoPrimaryRS2.Fields("bmbh").Value
''    If Len(s) > 2 Then
''    sTmp = Left(s, Len(s) - 2)
''    On Error Resume Next
''
''    adoPrimaryRS3.Find "xh='" & sTmp & "'", 0, adSearchForward, adBookmarkFirst
''    If Not adoPrimaryRS3.EOF Then
''    adoPrimaryRS2.Fields("pxh").Value = adoPrimaryRS3.Fields("xh").Value
''    Else
''    adoPrimaryRS2.Fields("pxh").Value = 0
''    End If
''    End If
''    adoPrimaryRS2.Update
''    adoPrimaryRS2.MoveNext
''    Next i
'
'
'
'
''strSQL = "delete from depart"
''mDB.ExecuteSQL strSQL
''strSQL = "select * from depart"
''Set adoprimaryRS = mDB.adoprimaryRS(strSQL)
''
''With adoPrimaryRS2
''    .MoveFirst
''    Do While Not .EOF
''    adoprimaryRS.AddNew
''    adoprimaryRS.Fields("dptid").Value = .Fields("xh").Value
''    'adoprimaryRS.Fields("dptno").Value = Format(.Fields("xh").Value, "0000")
''    adoprimaryRS.Fields("dptno").Value = .Fields("bmbh").Value
''    adoprimaryRS.Fields("dptparent").Value = .Fields("pxh").Value
''    adoprimaryRS.Fields("dptname").Value = .Fields("bmmc").Value
''    adoprimaryRS.Fields("ify").Value = 1     ''' .Fields("bmmc").Value
''    adoprimaryRS.Update
''    .MoveNext
''    Loop
''End With
'
'
'
'                  strSQL = "select * from zgda_jbxxk"     '''天平
'Set adoprimaryRS = db.adoprimaryRS(strSQL)
''                  strSQL = "select * from bmxxk"     '''天平
''Set adoPrimaryRS3 = db.adoPrimaryRS(strSQL)
'With adoprimaryRS
'    .MoveFirst
'    Do While Not .EOF
'      adoPrimaryRS2.Find "bmbh='" & .Fields("bmbh").Value & "'", 0, adSearchForward, adBookmarkFirst
'  If Not adoPrimaryRS2.EOF Then
'  .Fields("zgsg").Value = adoPrimaryRS2.Fields("xh").Value
'  .Update
'  End If
'  .MoveNext
'  Loop
'  .MoveFirst
'
'  End With
'
'
'
'
'                 strSQL = "select zcbj,zggh,zgxm,jcsj,lzsj,bmmc from zgda_jbxxk a,bmxxk b where a.bmbh=b.bmbh"     '''天平
'
'
'
'         Set adoRS = db.adoprimaryRS(strSQL)
'
''Debug.Print adoRS.RecordCount
'
'
'        'Redo:
'        strSQL2 = "delete from emply2"
'        mDB.ExecuteSQL strSQL2
'        '                strSQL2 = "select count(*) from emply2"
'        '                Set adoPrimaryRS2 = mDB.adoprimaryRS(strSQL2)
'        '                If adoPrimaryRS2(0).Value Then GoTo Redo
'
'        strSQL3 = "select * from emply"
'        Set adoPrimaryRS3 = mDB.adoprimaryRS(strSQL3)
'
'        strSQL2 = "select * from emply2"
'        Set adoPrimaryRS2 = mDB.adoprimaryRS(strSQL2)
'        With adoRS
'            If .RecordCount = 0 Then Exit Sub
'
'
'        .MoveFirst
'            Do Until .EOF
'            If .Fields("zcbj").Value <> 0 Then
'                adoPrimaryRS2.AddNew
'                adoPrimaryRS2.Fields("ifin").Value = .Fields("zcbj").Value
'                adoPrimaryRS2.Fields("partname").Value = .Fields("bmmc").Value
'                adoPrimaryRS2.Fields("emplyid").Value = "00" & .Fields("zggh").Value
'                adoPrimaryRS2.Fields("emplyname").Value = LeftB(.Fields("zgxm").Value, 8)
'                adoPrimaryRS2.Fields("indate").Value = .Fields("jcsj").Value
'                adoPrimaryRS2.Fields("outdate").Value = .Fields("lzsj").Value
'                '    adoprimaryRS2.Fields("gangwei").Value = .Fields("gangwei").Value
'                adoPrimaryRS2.Update
'            Else
'            'adoPrimaryRS3.Find "emplyid='" & "00" & .Fields("工号").Value & "'", 0, adSearchForward, adBookmarkFirst
'            adoPrimaryRS3.Filter = "emplyid='00" & .Fields("zggh").Value & "'"        ''', 0, adSearchForward, adBookmarkFirst
'            If adoPrimaryRS3.RecordCount Then
'            adoPrimaryRS3.Fields("dptid").Value = 2
''            adoPrimaryRS3.Fields("empbirthday").Value = .Fields("csny").Value
'          adoPrimaryRS3.Update
'            End If
'            End If
'
'                .MoveNext
'            Loop
''        adoPrimaryRS2.Update
''        adoPrimaryRS3.Update
'       End With
'
'
'
'
'
'
'        ''''''新进人员；
'        strSQL = "select * from emply2 where emplyid not in (select emplyid from emply)"
'        Set adoRS = mDB.adoprimaryRS(strSQL)
'
'
'        Screen.MousePointer = 0
'
'        If MsgBox("更新后合计人员——" & adoPrimaryRS2.RecordCount & "其中有" & adoRS.RecordCount & "为新进人员。现在加入吗？", vbYesNo, "NewAsia") = vbYes Then
'            strSQL2 = "select top 10 * from emply"
'            Set adoPrimaryRS2 = mDB.adoprimaryRS(strSQL2)
'            If adoRS.RecordCount Then
'                adoRS.MoveFirst
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -