?? module1.bas
字號:
' 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
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -