查询值和目标字段的数量不同。 Debug将我重定向到这一行:dbs.Execute strSQL,dbFailOnError
这是我的代码:
Public Function GetMatches(Column1 As String, Column2 As String)
Dim dbs As DAO.Database
Dim rcrdStColumn1 As Recordset
Dim rcrdStColumn2 As Recordset
Dim defaultTable1 As String
Dim defaultTable2 As String
Dim strSQL As String
Dim strSQLColumn1 As String
Dim strSQLColumn2 As String
Dim firstCurrentValue As String
Dim secondCurrentValue As String
Dim currentResultComparison As Double
Dim maxResultComparison As Double
Dim checkColumn1 As Boolean
Dim checkColumn2 As Boolean
Set dbs = CurrentDb
defaultTable1 = "CEE_Names_for_CUST_DES"
defaultTable2 = "GSNDG_Names"
'Check if column exists in table 1
checkColumn1 = checkColumn(Column1, defaultTable1)
checkColumn2 = checkColumn(Column2, defaultTable2)
If checkColumn1 = False Then
MsgBox ("Column 1 does not exist")
ElseIf checkColumn2 = False Then
MsgBox ("Column 2 does not exist")
Else
strSQLColumn1 = "SELECT " & Column1 & " FROM " & defaultTable1 & " ;"
Set rcrdStColumn1 = dbs.OpenRecordset(strSQLColumn1)
strSQLColumn2 = "SELECT " & Column2 & " FROM " & defaultTable2 & " ;"
Do While Not rcrdStColumn1.EOF
firstCurrentValue = rcrdStColumn1.Fields(Column1)
maxResultComparison = 0
Set rcrdStColumn2 = dbs.OpenRecordset(strSQLColumn2)
Do While Not rcrdStColumn2.EOF
secondCurrentValue = rcrdStColumn2.Fields(Column2)
currentResultComparison = modSimil.Simil(firstCurrentValue, secondCurrentValue)
strSQL = "INSERT INTO results(Column1, Column2, Similarities)" _
& " VALUES( '" & clearString(firstCurrentValue) & "', '" & clearString(secondCurrentValue) & "', " & Round(currentResultComparison, 2) & " )"
dbs.Execute strSQL, dbFailOnError
If currentResultComparison > maxResultComparison Then
maxResultComparison = currentResultComparison
End If
rcrdStColumn2.MoveNext
Loop
rcrdStColumn1.MoveNext
Loop
End If
dbs.Close
Set dbs = Nothing
End Function
Function checkColumn(strColumn As String, strTable As String) As Boolean
On Error GoTo checkColumnError
If (DCount(strColumn, strTable) = 0) Then
checkColumn = False
Else
checkColumn = True
End If
checkColumnError:
If Err.Number = 2741 Then
MsgBox ("2741")
ElseIf checkColumn Then
checkColumn = True
Else
checkColumn = False
End If
End Function
Function clearResult()
Dim dbs As DAO.Database
Dim strSQL As String
Set dbs = CurrentDb
strSQL = "DELETE FROM results"
dbs.Execute strSQL, dbFailOnError
dbs.Close
Set dbs = Nothing
End Function
Function clearString(str As String) As String
clearString = Replace(str, "'", "")
End Function