⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 tp_refresh.frm

📁 考勤系统,智能判断刷卡异常,是一大型ERP系统的一个分支
💻 FRM
📖 第 1 页 / 共 2 页
字号:
If adoprimaryRS.RecordCount Then
bHave = True
s2 = adoprimaryRS.Fields("CardNo").Value
GoTo GO11
End If

GO11:
If bHave Then


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='" & s & "'"
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
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
    
''    strSQL = "update CardData set GetCardHolder=CardNo where len(GetCardHolder)=4"
''    mDB.ExecuteSQL strSQL
    
    
    
    Dim stmp As String
   'stmp = InputBox("请输入姓名关键字:")
    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;"
   
   
'   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 HolderData.HolderName like '%" & stmp & "%' ORDER BY DepartmentData.DepartmentNo;"
   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 CardData.CardNo = '" & stmp & "' ORDER BY DepartmentData.DepartmentNo;"
Set adoPrimaryRS2 = mDB.adoprimaryRS(strSQL2)



If adoPrimaryRS2.RecordCount = 0 Then


strSQL = "select * from HolderCardData where CardNo='" & stmp & "'"
Set adoprimaryRS = mDB.adoprimaryRS(strSQL)
If adoprimaryRS.RecordCount Then

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

strSQL = "update CardData set GetCardHolder='" & stmp & "' where GetCardHolder='" & s2 & "'"
mDB.ExecuteSQL strSQL
'strSQL = "update EntryExitHolderData set HolderNo='" & s2 & "' where HolderNo='" & s & "'"
'mDB.ExecuteSQL strSQL

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


strSQL = "select * from CardData where CardNo='" & stmp & "'"
Set adoprimaryRS = mDB.adoprimaryRS(strSQL)
If adoprimaryRS.RecordCount Then
s2 = adoprimaryRS.Fields("GetCardHolder").Value

strSQL = "update CardData set GetCardHolder='" & stmp & "' where GetCardHolder='" & s2 & "'"
mDB.ExecuteSQL strSQL
'strSQL = "update EntryExitHolderData set HolderNo='" & s2 & "' where HolderNo='" & s & "'"
'mDB.ExecuteSQL strSQL

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


End If


Reload_PrimaryRS
'End If



End Select

Exit Sub
Err1:
MsgBox "对不起,更改失败。" & Err.Number & "--" & Err.Description & vbCrLf & strSQL

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

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;"
Set adoPrimaryRS2 = mDB.adoprimaryRS(strSQL2)

Reload_PrimaryRS

Set SqlmDB = New mDB
SqlmDB.InitDB_SQL "192.168.100.201", "xinya", "Reformer", "5148936"

'SqlmDB.InitDB_SQL "tp01", "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 = "CardID"
    txtFields(2).DataField = "HolderName"
    txtFields(3).DataField = "HolderNo"
'    Label2 = adoprimaryRS2.RecordCount
   Exit Sub
Err1:
   MsgBox Err.Description
End Sub

⌨️ 快捷键说明

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