-2147217913(80040e07)标准表达式中数据类型不匹配
Option Explicit
Dim cnn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim rs2 As New ADODB.Recordset
Public Function ConnectionToServer(strpath As String) As Boolean
On Error GoTo connectErr
cnn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strpath & "db1.mdb"
cnn.ConnectionTimeout = 30
cnn.Open
ConnectionToServer = True
Exit Function
connectErr:
ConnectionToServer = False
MsgBox "错误代码: " & Err.Number & vbCrLf & _
"错误描述: " & Err.Description, vbCritical + vbOKOnly, "连接错误"
End Function
Public Function DisConnect() As Boolean
If cnn.State = adStateOpen Then
cnn.Close
End If
DisConnect = True
End Function
Public Function ExecuteSQL(ByVal strSQL As String) As Boolean
' On Error Resume Next
cnn.Execute (strSQL)
If Err.Number > 0 Then
Err.Clear
ExecuteSQL = False
Else
ExecuteSQL = True
End If
End Function
Public Function QueryData(ByVal strSQL As String) As Boolean
'On Error Resume Next
Set rs = New ADODB.Recordset
Call rs.Open(strSQL, cnn, adOpenDynamic, adLockOptimistic, -1)
If Err.Number > 0 Then
Err.Clear
QueryData = False
Else
QueryData = True
End If
End Function
Public Function QueryData2(ByVal strSQL As String) As Boolean
'On Error Resume Next
Set rs2 = New ADODB.Recordset
cnn.CursorLocation = adUseClient
Call rs2.Open(strSQL, cnn, adOpenDynamic, adLockOptimistic, -1)
If Err.Number > 0 Then
Err.Clear
QueryData2 = False
Else
QueryData2 = True
End If
End Function
Private Sub Command1_Click()
With cd1Open
.DialogTitle = "选择导入文件"
.Filter = "(*.*)|*.*"
.ShowOpen
If Len(.FileName) = 0 Then Exit Sub
Text1.Text = .FileName
End With
End Sub
Private Sub Command2_Click()
With cd1Open
.DialogTitle = "选择比对文件"
.Filter = "(*.*)|*.*"
.ShowOpen
If Len(.FileName) = 0 Then Exit Sub
Text2.Text = .FileName
End With
End Sub
Private Sub Command3_Click()
Dim strSQL As String
Dim aTmp As String
Dim strpath As String
strpath = "E:"
Dim Connected As Boolean
Connected = ConnectionToServer(strpath)
If Text1.Text = "" Then
MsgBox "请选择导入文件"
Exit Sub
End If
If Text2.Text = "" Then
MsgBox "请选择比对文件"
Exit Sub
End If
Dim Path As String, FileName As String, S() As String
Path = Text1.Text
S = Split(Path, "")
FileName = S(UBound(S))
Dim Path2 As String, FileName2 As String, S2() As String
Path2 = Text2.Text
S2 = Split(Path2, "")
FileName2 = S2(UBound(S2))
Dim bTmp As String '卡号
Dim cTmp As String '业务编码
Dim dTmp As String '金额
'----------------------------------------------------------
If Connected = True Then
If InStr(FileName, "062010496") > 0 And InStr(FileName2, "d14046") > 0 Then
Dim eTmp As String
Dim strSQL1 As String
Dim h As String
Dim k As String
strSQL1 = "Select cardno, yewubianma, jine from duibiwenjian1"
QueryData (strSQL1)
h = rs("cardno")
k = rs("jine")
Dim strSQL2 As String
strSQL2 = "select * from daoruwenjian1 where yewubianma= 062010559 and cardno='" & h & "'"
Do While Not rs.EOF
QueryData2 (strSQL2)
If rs2.RecordCount = 1 Then
If rs2("jine") = k Then
Open "E:\导入文件1比对相符清单.txt " For Output As #1
eTmp = rs2!yewubianma & vbTab & rs2!cardno & vbTab & rs2!jine & vbCrLf
Print #1, eTmp
'else 此处金额若不相等怎么办，客户没交代
End If
Close #1
ElseIf rs2.RecordCount = 0 Then
Open "E:\导入文件1存疑清单.txt " For Output As #1
eTmp = rs!yewubianma & vbTab & rs!cardno & vbTab & rs!jine & vbCrLf
Print #1, eTmp
Close #1
Else
Open "E:\导入文件1导入不成功清单.txt " For Output As #1
Do While Not rs2.EOF
eTmp = rs2!yewubianma & vbTab & rs2!cardno & vbTab & rs2!jine & vbCrLf
Print #1, eTmp
rs2.MoveNext
Loop
Close #1
End If
rs.MoveNext
Loop
rs.Close
rs2.Close
cnn.Close
End If
If InStr(FileName, "062010495") > 0 And InStr(FileName2, "d14046") > 0 Then
Dim eTmp2 As String
Dim strSQL3 As String
Dim h2 As String
Dim k2 As String
strSQL3 = "Select cardno, yewubianma, jine from duibiwenjian1"
QueryData (strSQL3)
h2 = rs("cardno")
k2 = rs("jine")
Dim strSQL4 As String
strSQL4 = "select * from daoruwenjian2 where yewubianma=062010558 and cardno='" & h & "'"
Do While Not rs.EOF
QueryData2 (strSQL4)
If rs2.RecordCount = 1 Then
If rs2("jine") = k2 Then
Open "E:\导入文件2比对相符清单.txt " For Output As #1
eTmp2 = rs2!yewubianma & vbTab & rs2!cardno & vbTab & rs2!jine & vbCrLf
Print #1, eTmp2
'else 此处金额若不相等怎么办，客户没交代
End If
Close #1
ElseIf rs2.RecordCount = 0 Then
Open "E:\导入文件2存疑清单.txt " For Output As #1
eTmp2 = rs!yewubianma & vbTab & rs!cardno & vbTab & rs!jine & vbCrLf
Print #1, eTmp2
Close #1
Else
Open "E:\导入文件2导入不成功清单.txt " For Output As #1
Do While Not rs2.EOF
eTmp2 = rs2!yewubianma & vbTab & rs2!cardno & vbTab & rs2!jine & vbCrLf
Print #1, eTmp2
rs2.MoveNext
Loop
Close #1
End If
rs.MoveNext
Loop
rs.Close
rs2.Close
cnn.Close
End If
If InStr(FileName, "00200-BFHXFTZD") > 0 And InStr(FileName2, "d14231") > 0 Then
Dim eTmp3 As String
Dim strSQL5 As String
Dim h3 As String
Dim k3 As String
strSQL5 = "Select cardno, jine from duibiwenjian2"
QueryData (strSQL5)
h3 = rs("cardno")
k3 = rs("jine")
Dim strSQL6 As String
strSQL6 = "select * from daoruwenjian2 where cardno='" & h & "'"
Do While Not rs.EOF
QueryData2 (strSQL6)
If rs2.RecordCount = 1 Then
If rs2("jine") = k3 Then
Open "E:\导入文件3比对相符清单.txt " For Output As #1
eTmp3 = rs2!cardno & vbTab & rs2!jine & vbCrLf
Print #1, eTmp3
'else 此处金额若不相等怎么办，客户没交代
End If
Close #1
ElseIf rs2.RecordCount = 0 Then
Open "E:\导入文件3存疑清单.txt " For Output As #1
eTmp3 = rs!cardno & vbTab & rs!jine & vbCrLf
Print #1, eTmp3
Close #1
Else
Open "E:\导入文件3导入不成功清单.txt " For Output As #1
Do While Not rs2.EOF
eTmp3 = rs2!cardno & vbTab & rs2!jine & vbCrLf
Print #1, eTmp3
rs2.MoveNext
Loop
Close #1
End If
rs.MoveNext
Loop
rs.Close
rs2.Close
cnn.Close
End If
'---------------------------------------------------
End If
End Sub
Private Sub Command4_Click()
End
End Sub
总是报-2147217913(80040e07)标准表达式中数据类型不匹配
到底是哪里错了，哪位高手给指点一下，谢谢
[解决办法]
strSQL2 = "select * from daoruwenjian1 where yewubianma= '062010559' and cardno='" & h & "'"
