tp_refresh2.frm

考勤系统,智能判断刷卡异常,是一大型ERP系统的一个分支

If adoprimaryRS.RecordCount Then bHave = True


strSQL = "select * from HolderData where HolderNo='" & s & "'"
Set adoprimaryRS = mDB.adoprimaryRS(strSQL)
If adoprimaryRS.RecordCount Then bHave = True

strSQL = "select * from HolderCardData where HolderNo='" & s & "'"
Set adoprimaryRS = mDB.adoprimaryRS(strSQL)
If adoprimaryRS.RecordCount Then bHave = True


If bHave Then

s2 = adoprimaryRS.Fields("CardNo").Value

If s2 <> txtFields(0).Text Then
strSQL = "update CardData set GetCardHolder='" & s2 & "' where CardNo='" & s & "'"
mDB.ExecuteSQL strSQL
strSQL = "update EntryExitHolderData set HolderNo='" & s2 & "' where HolderNo='" & s & "'"
mDB.ExecuteSQL strSQL

strSQL = "update HolderCardData set HolderNo='" & s2 & "' where CardNo='" & s2 & "'"
mDB.ExecuteSQL strSQL
strSQL = "update HolderData set HolderNo='" & s2 & "' where HolderNo='" & s & "'"
mDB.ExecuteSQL strSQL
End If



strSQL = "update CardData set GetCardHolder='" & s & "' where CardNo='" & txtFields(0).Text & "'"
mDB.ExecuteSQL strSQL
strSQL = "update EntryExitHolderData set HolderNo='" & s & "' where HolderNo='" & txtFields(3).Text & "'"
mDB.ExecuteSQL strSQL

strSQL = "update HolderCardData set HolderNo='" & s & "' where CardNo='" & txtFields(0).Text & "'"
mDB.ExecuteSQL strSQL
strSQL = "update HolderData set HolderNo='" & s & "' where HolderNo='" & txtFields(3).Text & "'"
mDB.ExecuteSQL strSQL



strSQL = "update IOData set HolderNo='" & s & "' where CardNo='" & txtFields(0).Text & "' and IODate=#" & DTPicker1.Value & "#"
mDB.ExecuteSQL strSQL


MsgBox "恭喜你，修改成功。"


Else

strSQL = "update CardData set GetCardHolder='" & s & "' where CardNo='" & txtFields(0).Text & "'"
mDB.ExecuteSQL strSQL
strSQL = "update EntryExitHolderData set HolderNo='" & s & "' where HolderNo='" & txtFields(3).Text & "'"
mDB.ExecuteSQL strSQL

strSQL = "update HolderCardData set HolderNo='" & s & "' where CardNo='" & txtFields(0).Text & "'"
mDB.ExecuteSQL strSQL
strSQL = "update HolderData set HolderNo='" & s & "' where HolderNo='" & txtFields(3).Text & "'"
mDB.ExecuteSQL strSQL
MsgBox "恭喜你，修改成功。"


End If


Else
MsgBox "对不起，可能工号有误，不能修改。"

End If



Case 2
Unload Me
'Case 3
'
'Screen.MousePointer = 11
'
' On Error Resume Next
' Dim n As Integer
' Dim sName As String
'
'
'strSQL = "select * from HolderData where  len(HolderNo)=6"
'Set adoprimaryRS = mDB.adoprimaryRS(strSQL)
'
'With adoprimaryRS
'    .MoveFirst
'    Do While Not .EOF
'    sName = ""
'    adoPrimaryRS3.Find "zggh='" & .Fields("HolderNo").Value & "'", 0, adSearchForward, adBookmarkFirst
'    If Not adoPrimaryRS3.EOF Then
'    Debug.Print InStrB(adoPrimaryRS3.Fields("zgxm").Value, " ")
'    sName = Left(adoPrimaryRS3.Fields("zgxm").Value, (InStrB(adoPrimaryRS3.Fields("zgxm").Value, " ") - 1) / 2)
'
'    .Fields("HolderName").Value = sName   ''' Left(adoPrimaryRS3.Fields("zgxm").Value, InStrB(adoPrimaryRS3.Fields("zgxm").Value, " ") - 1)
'    .Update
'    n = n + 1
'    End If
'    .MoveNext
'    Loop
'
'End With
'strSQL = "select * from CardData where  len(GetCardHolder)=6"
'Set adoprimaryRS = mDB.adoprimaryRS(strSQL)
'With adoPrimaryRS3
'    .MoveFirst
'    Do While Not .EOF
'    adoprimaryRS.Find "GetCardHolder='" & .Fields("zggh").Value & "'", 0, adSearchForward, adBookmarkFirst
'    If Not adoprimaryRS.EOF Then
'    .Fields("zgjc").Value = adoprimaryRS.Fields("CardNo").Value
'    .Update
'        n = n + 1
'    End If
'    .MoveNext
'    Loop
'
'
'End With
'
'MsgBox n & "条记录被成功修改。"
'Screen.MousePointer = 0
'
'
'
'
'    Case 4
'    Dim stmp As String
'    stmp = InputBox("请输入姓名关键字：")
'    If Len(s) Then
'    'adoPrimaryRS2.Filter = "len(HolderData.HolderNo)<6"
'   strSQL2 = "SELECT DepartmentData.DepartmentNo, CardData.CardNo, CardData.CardID, HolderData.HolderNo, HolderData.HolderName " & _
'" FROM DepartmentData INNER JOIN ((HolderCardData INNER JOIN CardData ON HolderCardData.CardNo = CardData.CardNo) INNER JOIN HolderData ON HolderCardData.HolderNo = HolderData.HolderNo) ON DepartmentData.DepartmentNo = HolderData.DepartmentNo WHERE ((Len(CardID)>3)) and ((len(HolderData.HolderNo)<6)) and HolderData.HolderName like '%" & stmp & "' ORDER BY DepartmentData.DepartmentNo;"
'Set adoPrimaryRS2 = mDB.adoprimaryRS(strSQL2)
'
'Reload_PrimaryRS
'End If



End Select

Exit Sub
Err1:
MsgBox "对不起，更改失败。"
End Sub

Private Sub cmdAdd_MouseDown(Index As Integer, Button As Integer, Shift As Integer, X As Single, Y As Single)

On Error GoTo Err1
If Button = 2 Then
Select Case Index
Case 0
'adoPrimaryRS2.Filter = "len(HolderData.HolderNo)<6"
   strSQL2 = "SELECT DepartmentData.DepartmentNo, CardData.CardNo, CardData.CardID, HolderData.HolderNo, HolderData.HolderName " & _
" FROM DepartmentData INNER JOIN ((HolderCardData INNER JOIN CardData ON HolderCardData.CardNo = CardData.CardNo) INNER JOIN HolderData ON HolderCardData.HolderNo = HolderData.HolderNo) ON DepartmentData.DepartmentNo = HolderData.DepartmentNo WHERE ((Len(CardID)>3)) and ((len(HolderData.HolderNo)<6)) ORDER BY DepartmentData.DepartmentNo;"
Set adoPrimaryRS2 = mDB.adoprimaryRS(strSQL2)
Reload_PrimaryRS
ToExcel.ToExcel adoPrimaryRS2

End Select

End If

Exit Sub
Err1:
MsgBox "对不起，更改失败。"

End Sub

Private Sub Command1_Click(Index As Integer)
On Error GoTo Err1

Select Case Index
Case 0
adoPrimaryRS2.MoveFirst
Case 1
adoPrimaryRS2.MovePrevious
Case 2
adoPrimaryRS2.MoveNext
Case 3
adoPrimaryRS2.MoveLast

End Select
txtFields(4).Text = ""
adoPrimaryRS3.Find "zgxm='" & txtFields(2).Text & "'", 0, adSearchForward, adBookmarkFirst
If Not adoPrimaryRS3.EOF Then
txtFields(4).Text = adoPrimaryRS3.Fields("zggh").Value
End If

Exit Sub
Err1:
MsgBox Err.Description


End Sub

Private Sub Form_Load()

On Error GoTo Err1

DTPicker1.Value = Date


Set mDB = New mDB
mDB.InitDB_RY "Provider=msdasql;uid=;pwd=;dsn=KaoQin;"

'strSQL = "select * from DepartmentData"
'Set adoprimaryRS = mDB.adoprimaryRS(strSQL)
'        With DataCombo1(0)
'        Set .RowSource = adoprimaryRS
'        .BoundColumn = "DepartmentNO"
'        .ListField = "DepartmentName"
'        .Refresh
'    End With
'   strSQL2 = "SELECT DepartmentData.DepartmentNo, CardData.CardNo, CardData.CardID, HolderData.HolderNo, HolderData.HolderName " & _
'" FROM DepartmentData INNER JOIN ((HolderCardData INNER JOIN CardData ON HolderCardData.CardNo = CardData.CardNo) INNER JOIN HolderData ON HolderCardData.HolderNo = HolderData.HolderNo) ON DepartmentData.DepartmentNo = HolderData.DepartmentNo WHERE ((Len(CardID)>3)) ORDER BY DepartmentData.DepartmentNo;"


strSQL2 = "select distinct CardNo,HolderNo,HolderName from IOData where len(HolderNo)=4 and IODate=#" & DTPicker1.Value & "#"
Set adoPrimaryRS2 = mDB.adoprimaryRS(strSQL2)


Reload_PrimaryRS

Set SqlmDB = New mDB
'SqlmDB.InitDB_SQL "tp01", "xinya", "reformer", "5148936"
SqlmDB.InitDB_SQL "192.168.100.201", "xinya", "Reformer", "5148936"
'SqlmDB.InitDB_SQL "tianping", "xinya", "reformer", "5148936"
strSQL3 = "select zggh,zgxm,zgjc from zgda_jbxxk"
Set adoPrimaryRS3 = SqlmDB.adoprimaryRS(strSQL3)

Exit Sub

Err1:
MsgBox Err.Description


End Sub



Private Sub Reload_PrimaryRS()
On Error GoTo Err1

    ' RELOADING DATA OBJECTS AND DATABASE CONNECTIONS
    '    On Error Resume Next
    Dim otext As TextBox
    Dim i As Integer

    For i = 0 To 3
        Set txtFields(i).DataSource = adoPrimaryRS2
    Next
'    Set DataCombo1(0).DataSource = adoPrimaryRS2
'
'    DataCombo1(0).DataField = "DepartmentNo"
    txtFields(0).DataField = "CardNo"
    txtFields(1).DataField = "CardNo"     ''''"CardID"
    txtFields(2).DataField = "HolderName"
    txtFields(3).DataField = "HolderNo"
'    Label2 = adoprimaryRS2.RecordCount
   Exit Sub
Err1:
   MsgBox Err.Description
End Sub