📄 module1.bas

📁 考勤系统,智能判断刷卡异常,是一大型ERP系统的一个分支
💻 BAS
📖 第 1 页 / 共 3 页
字号:
上一页 1 23
'                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 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
'
'             MsgBox "更新OK！"
       
        
        
        
        
        
        
        
        
        
        
        
        
            Case 1       ''''(自动考勤更新)
        
        
'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)
  
'  Debug.Print strconnDR
  
mDB.InitDB_RY strconnDR

'strSQL = "delete from depart"
'mDB.ExecuteSQL strSQL
strSQL = "select * from depart"
Set adoRS_Depart = 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,csny,zgxb,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)
        
        strSQL3 = "select * from depart"
        Set adoRS_Depart = mDB.adoprimaryRS(strSQL3)
        
strSQL = "select zcbj,zggh,zgxm,jcsj,lzsj,bmmc,csny,zgxb,ylbj,bmmc,zwmc  from zgda_jbxxk a,bmxxk b,zwxxk c where a.zwbh=c.zwbh and a.bmbh=b.bmbh"     '''天平
Set adoRS = db.adoprimaryRS(strSQL)

                
        With adoRS   '''zgda_jbxxk
            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" & Left(.Fields("zggh").Value, 6)
                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("csny").Value = .Fields("csny").Value
               adoPrimaryRS2.Fields("zwmc").Value = .Fields("zwmc").Value
                
                
                adoPrimaryRS2.Fields("zgxb").Value = .Fields("zgxb").Value
                adoRS_Depart.Find "dptname='" & .Fields("bmmc").Value & "'", 0, adSearchForward, adBookmarkFirst
                
                If adoRS_Depart.EOF Then
                adoPrimaryRS2.Fields("dptid").Value = 1
                Else
                adoPrimaryRS2.Fields("dptid").Value = adoRS_Depart.Fields("dptid").Value
                End If
                
                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


On Error Resume Next


  ''''''进厂日期如果正好在假日或星期六，星期天的向后推迟；
GoOn1:
  strSQL = "select * from emply2 where indate in (select JR_date from CC_JRdate)"
  Set adoprimaryRS = mDB.adoprimaryRS(strSQL)
  If adoprimaryRS.RecordCount Then
  With adoprimaryRS
  .MoveFirst
  Do While Not .EOF
  .Fields("indate").Value = DateAdd("d", 1, .Fields("indate").Value)
  .Update
  .MoveNext
  Loop
  End With
  GoTo GoOn1
  End If
  ''''''进厂日期如果正好在假日或星期六，星期天的向后推迟；
  ''''''离职日期如果正好在假日或星期六，星期天的向前推进；
GoOn2:
   strSQL = "select * from emply2 where (outdate is not null) and outdate in (select JR_date from CC_JRdate)"
  Set adoprimaryRS = mDB.adoprimaryRS(strSQL)
  If adoprimaryRS.RecordCount Then
  With adoprimaryRS
  .MoveFirst
  Do While Not .EOF
  .Fields("outdate").Value = DateAdd("d", -1, .Fields("outdate").Value)
  .Update
  .MoveNext
  Loop
  End With
  GoTo GoOn2
  End If
  ''''''离职日期如果正好在假日或星期六，星期天的向前推进；
 
    ''''''如果进厂日期大离职日期，则进厂日期等离职日期；
strSQL = "update emply2 set outdate=indate where indate>outdate"
mDB.ExecuteSQL strSQL
    ''''''如果进厂日期大离职日期，则进厂日期等离职日期；

  

      

        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
        Screen.MousePointer = 11
            strSQL2 = "select  * from emply"
            Set adoPrimaryRS2 = mDB.adoprimaryRS(strSQL2)
            
        strSQL3 = "select * from emply2"
        Set adoPrimaryRS3 = mDB.adoprimaryRS(strSQL3)
  With adoPrimaryRS3
    .MoveFirst
    Do While Not .EOF

    adoPrimaryRS2.Find "emplyid='" & .Fields("emplyid").Value & "'", 0, adSearchForward, adBookmarkFirst
    If adoPrimaryRS2.EOF Then
        adoPrimaryRS2.AddNew
        adoPrimaryRS2.Fields("emplyid").Value = .Fields("emplyid").Value
        adoPrimaryRS2.Fields("emplyname").Value = .Fields("emplyname").Value
        adoPrimaryRS2.Fields("dptid").Value = .Fields("dptid").Value
        adoPrimaryRS2.Fields("empbirthday").Value = .Fields("csny").Value
        adoPrimaryRS2.Fields("empsex").Value = .Fields("zgxb").Value
        adoPrimaryRS2.Fields("zcbj").Value = .Fields("ifin").Value
        adoPrimaryRS2.Fields("empcrdyn").Value = 1
        adoPrimaryRS2.Fields("serial").Value = Format(CLng(100000 * Rnd), "#####")
    Else
'        adoPrimaryRS2.Fields("emplyid").Value = .Fields("emplyid").Value
'        adoPrimaryRS2.Fields("emplyname").Value = .Fields("emplyname").Value
        adoPrimaryRS2.Fields("dptid").Value = .Fields("dptid").Value
        adoPrimaryRS2.Fields("empbirthday").Value = .Fields("csny").Value
        adoPrimaryRS2.Fields("empsex").Value = .Fields("zgxb").Value
        adoPrimaryRS2.Fields("zcbj").Value = .Fields("ifin").Value
'        adoPrimaryRS2.Fields("empcrdyn").Value = 1
'        adoPrimaryRS2.Fields("serial").Value = Format(CLng(100000 * Rnd), "#####")
    End If
    adoPrimaryRS2.Update
    .MoveNext
    Loop
    
  End With
  
            
   End If
   
            
            
'            If adoRS.RecordCount Then
'                adoRS.MoveFirst
'                Do While Not adoRS.EOF
'                    With adoPrimaryRS2
'                        .AddNew
'                        .Fields("emplyid").Value = adoRS.Fields("emplyid").Value
'                        .Fields("emplyname").Value = adoRS.Fields("emplyname").Value
'                        .Fields("dptid").Value = adoRS.Fields("dptid").Value
'                        .Fields("empbirthday").Value = adoRS.Fields("csny").Value
'                        .Fields("empsex").Value = adoRS.Fields("zgxb").Value
'                        .Fields("zcbj").Value = adoRS.Fields("ifin").Value
'                        .Fields("empcrdyn").Value = 1
'                        .Fields("serial").Value = Format(CLng(100000 * Rnd), "#####")
'                        .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 = adoRS.Fields("zgxb").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
        
       ''''''''''////////////**********************///////////////////////
        
      
        
        
        
        
        
             Screen.MousePointer = 0
   
        
          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
上一页 1 23
⌨️ 快捷键说明

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