Access VBA中DLookup函数类型不匹配错误求助

问题核心 #

Results2表的ID列是数字类型，但DLookup查询中错误地用单引号包裹了newid，导致SQL查询时将数字字段和字符串进行比较，触发类型不匹配错误。即使修改newid的变量类型，也因为SQL语法错误无法解决。

原错误代码片段：

If DLookup("[Result" & i & "]", "Results2", "[ID] = '" & newid & "'") <> Me.Controls("C" & 3 + column & "R" & i + j).Value Then

错误原因分析 #

1. SQL语法错误：数字类型字段的查询条件不需要单引号，单引号是字符串字段的标识。用'newid'会让Access尝试将数字ID转换为字符串进行匹配，引发类型不匹配。
2. 自动编号ID取值时机错误：原代码中rs.AddNew后直接取rs![ID].Value，此时记录尚未执行rs.Update，自动编号类型的ID还未生成有效值，导致newid存储的是Null或默认值，后续写入rs2、rs3的ID无效，DLookup自然无法匹配到正确记录。

修正步骤 #

1. 修正ID取值逻辑 #

将newid的赋值移到rs.Update之后，确保获取到正确的自动编号ID：

' 先完成rs的赋值和更新
With rs
    ![PartNum] = Me.FilterPartNumber.Value
    ![INDNum] = Me.INDNum.Value
    ![DateTime] = Me.DateTime.Value
    ![HTLotNum] = Me.HTLotNum.Value
    ![Operator] = Me.Inspector.Value
    ![Spindle] = Me.Controls("Spindle" & column).Value
    ![TypeofCheck] = Me.InspType.Value
    ![OverallResult] = Me.Controls("Result" & column).Value
End With
rs.Update ' 先更新rs，生成正确的ID
newid = rs![ID].Value ' 此时才能获取到有效的自动编号ID

' 再进行rs2、rs3的AddNew和赋值
rs2.AddNew
With rs2
    ![ID] = newid
    ' ... 其余赋值代码
End With
rs2.Update

rs3.AddNew
With rs3
    ![ID] = newid
    ' ... 其余赋值代码
End With
rs3.Update

2. 修正DLookup的SQL条件 #

去掉ID条件的单引号，确保数字字段和数值变量匹配：

If DLookup("[Result" & i & "]", "Results2", "[ID] = " & newid) <> Me.Controls("C" & 3 + column & "R" & i + j).Value Then

3. 修正变量类型 #

将newid的声明从String改为Long（适配Access自动编号字段的默认类型）：

Dim newid As Long

修正后的完整代码 #

Private Sub BtnSave_Click()
    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim rs2 As DAO.Recordset
    Dim rs3 As DAO.Recordset
    Dim i As Integer
    Dim j As Integer
    Dim ans As Integer
    Dim column As Integer
    Dim colcnt As Integer
    Dim newid As Long ' 修改为Long类型
    
    If IsNull(Me.Spindle3.Value) = False Then
        colcnt = 3
    ElseIf IsNull(Me.Spindle2.Value) = False Then
        colcnt = 2
    Else
        colcnt = 1
    End If
    
    column = 1
    Set db = CurrentDb
    Set rs = db.OpenRecordset("Results")
    Set rs2 = db.OpenRecordset("Results2")
    Set rs3 = db.OpenRecordset("Results3")
    
Linestart:
    j = 0
    rs.AddNew
    
    ' 先处理Result判断逻辑
    If Me.Result1.Value = "Fail" Or Me.Result2.Value = "Fail" Or Me.Result1.Value = "Fail" Then
        If column = 1 Then
            ans = MsgBox("This is a FAILING Result.  Do you with to save it?", vbYesNo)
            If ans = 7 Then GoTo Lineend
        End If
    ElseIf Me.Result1.Value = "Incomplete" Or Me.Result2.Value = "Incomplete" Or Me.Result2.Value = "Incomplete" Then
        If column = 1 Then
            ans = MsgBox("Testing is not finished for this part.  Do you with to save and close now?", vbYesNo)
            If ans = 7 Then GoTo Lineend
        End If
    End If
    
    ' 赋值并更新rs，获取有效ID
    With rs
        ![PartNum] = Me.FilterPartNumber.Value
        ![INDNum] = Me.INDNum.Value
        ![DateTime] = Me.DateTime.Value
        ![HTLotNum] = Me.HTLotNum.Value
        ![Operator] = Me.Inspector.Value
        ![Spindle] = Me.Controls("Spindle" & column).Value
        ![TypeofCheck] = Me.InspType.Value
        ![OverallResult] = Me.Controls("Result" & column).Value
    End With
    
    If IsNull(Me.HTLotNum.Value) = True Then
        rs![HTLotNum] = "(blank)"
    End If
    
    rs.Update ' 必须先更新rs才能获取正确的ID
    newid = rs![ID].Value ' 现在获取到有效的自动编号ID
    
    ' 处理rs2
    rs2.AddNew
    With rs2
        ![ID] = newid
        ![PartNum] = Me.FilterPartNumber.Value
        ![Plant] = Me.plantnum.Value
        ![DateTime] = Me.DateTime.Value
        ![HTLotNum] = Me.HTLotNum.Value
        ![Notes] = Me.Notes.Value
        ![Spindle] = Me.Spindle.Value
        ![TypeofCheck] = Me.InspType.Value
        ![OverallResult] = Me.Result1.Value
    End With
    
    ' 处理rs3
    rs3.AddNew
    With rs3
        ![ID] = newid
        ![PartNum] = Me.FilterPartNumber.Value
        ![DateTime] = Me.DateTime.Value
    End With
    
    ' 循环赋值细节字段
    For i = 1 To 90 Step 1
        If i + j >= 90 Then
            i = 90
            GoTo Line1
        End If
        If IsNull(Me.Controls("C3R" & i + j).Value) = True Then
            j = j + 1
        End If
        If i + j >= 90 Then
            i = 90
            GoTo Line1
        End If
        If IsNull(Me.Controls("C2R" & i + j).Value) = True Then GoTo Line1
        
        rs.Edit ' 因为已经Update过，需要重新Edit来修改细节字段
        rs("Char" & i) = Me!ListFeatures.column(1, i - 1)
        rs("Desc" & i) = Me!ListFeatures.column(2, i - 1)
        rs("Spec" & i) = Me!ListFeatures.column(3, i - 1) & " " & Me!ListFeatures.column(6, i - 1)
        rs.Update
        
        rs2("SC" & i) = Me!ListFeatures.column(4, i - 1)
        rs2("Location" & i) = Me!ListFeatures.column(5, i - 1)
        rs2("Result" & i) = Me.Controls("C" & 3 + column & "R" & i + j).Value
        
        rs3("Coding" & i) = Me!ListCoding.column(1, i - 1)
Line1:
    Next
    
    rs2.Update
    rs3.Update
    
    ' 验证数据的循环
    For i = 1 To 90 Step 1
        If i + j >= 90 Then
            i = 90
            GoTo Line2
        End If
        If IsNull(Me.Controls("C3R" & i + j).Value) = True Then
            j = j + 1
        End If
        If i + j >= 90 Then
            i = 90
            GoTo Line2
        End If
        
        ' 修正后的DLookup，去掉ID的单引号
        If DLookup("[Result" & i & "]", "Results2", "[ID] = " & newid) <> Me.Controls("C" & 3 + column & "R" & i + j).Value Then
            MsgBox "Results not saved! Document results on paper and contact the database engineer regarding this error."
            GoTo Lineend
        End If
Line2:
    Next
    
    If column < colcnt Then
        column = column + 1
        GoTo Linestart
    End If
    
Line2:
    Forms![Landing Page]![LIstIncomplete].Requery
    DoCmd.Close
    
Lineend:
    ' 清理对象
    Set rs3 = Nothing
    Set rs2 = Nothing
    Set rs = Nothing
    Set db = Nothing
End Sub

额外说明 #

• 原代码中在rs.Update后又循环修改rs的Char/Desc等字段，需要添加rs.Edit和rs.Update来保存这些修改，否则字段值不会写入数据库。
• 最后添加对象清理代码，避免内存泄漏。

内容的提问来源于stack exchange，提问作者dhunt