VBA代码在某些版本的Office中不起作用,在其他版本中起作用

时间:2017-07-28 10:43:39

标签: vba access-vba

查询值和目标字段的数量不同。 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

0 个答案:

没有答案