3146 ODBC调用失败 - 访问2010

Question

请参考下面的代码...

Private Sub Save_Click() 
    On Error GoTo err_I9_menu 
    Dim dba As Database 
    Dim dba2 As Database 
    Dim rst As Recordset 
    Dim rst1 As Recordset 
    Dim rst2 As Recordset 
    Dim rst3 As Recordset 
    Dim SQL As String 
    Dim dateandtime As String 
    Dim FileSuffix As String 
    Dim folder As String 
    Dim strpathname As String 
    Dim X As Integer 

    X = InStrRev(Me!ListContents, "\") 

    Call myprocess(True) 

    folder = DLookup("[Folder]", "Locaton", "[LOC_ID] = '" & Forms!frmUtility![Site].Value & "'") 
    strpathname = "\\Reman\PlantReports\" & folder & "\HR\Paperless\" 
    dateandtime = getdatetime() 

    If Nz(ListContents, "") <> "" Then 
    Set dba = CurrentDb 

    FileSuffix = Mid(Me!ListContents, InStrRev(Me!ListContents, "."), 4) 

    SQL = "SELECT Extension FROM tbl_Forms WHERE Type = 'I-9'" 
    SQL = SQL & " AND Action = 'Submit'" 

    Set rst1 = dba.OpenRecordset(SQL, dbOpenDynaset, dbSeeChanges) 

    If Not rst1.EOF Then 
     newname = Me!DivisionNumber & "-" & Right(Me!SSN, 4) & "-" & LastName & dateandtime & rst1.Fields("Extension") & FileSuffix 
    Else 
     newname = Me!DivisionNumber & "-" & Right(Me!SSN, 4) & "-" & LastName & dateandtime & FileSuffix 
    End If 

    Set moveit = CreateObject("Scripting.FileSystemObject") 

    copyto = strpathname & newname 
    moveit.MoveFile Me.ListContents, copyto 

    Set rst = Nothing 
    Set dba = Nothing 

    End If 

    If Nz(ListContentsHQ, "") <> "" Then 
    Set dba2 = CurrentDb 

    FileSuffix = Mid(Me.ListContentsHQ, InStrRev(Me.ListContentsHQ, "."), 4) 

    SQL = "SELECT Extension FROM tbl_Forms WHERE Type = 'HealthQuestionnaire'" 
    SQL = SQL & " AND Action = 'Submit'" 

    Set rst3 = dba2.OpenRecordset(SQL, dbOpenDynaset, dbSeeChanges) 

    If Not rst3.EOF Then 
     newname = Me!DivisionNumber & "-" & Right(Me!SSN, 4) & "-" & LastName & dateandtime & rst3.Fields("Extension") & FileSuffix 
    Else 
     newname = Me!DivisionNumber & "-" & Right(Me!SSN, 4) & "-" & LastName & dateandtime & FileSuffix 
    End If 

    Set moveit = CreateObject("Scripting.FileSystemObject") 

    copyto = strpathname & newname 
    moveit.MoveFile Me.ListContentsHQ, copyto 

    Set rst2 = Nothing 
    Set dba2 = Nothing 

    End If 

    Set dba = CurrentDb 

    Set rst = dba.OpenRecordset("dbo_tbl_EmploymentLog", dbOpenDynaset, dbSeeChanges) 

    rst.AddNew 
    rst.Fields("TransactionDate") = Date 
    rst.Fields("EmployeeName") = Me.LastName 
    rst.Fields("EmployeeSSN") = Me.SSN 
    rst.Fields("EmployeeDOB") = Me.EmployeeDOB 
    rst.Fields("I9Pathname") = strpathname 
    rst.Fields("I9FileSent") = newname 
    rst.Fields("Site") = DLookup("Folder", "Locaton", "Loc_ID='" & Forms!frmUtility!Site & "'") 
    rst.Fields("UserID") = Forms!frmUtility!user_id 
    rst.Fields("HqPathname") = strpathname 
    rst.Fields("HqFileSent") = newname2 
    rst.Update 

    Set dba = Nothing 
    Set rst = Nothing 

exit_I9_menu: 
    Call myprocess(False) 
    DivisionNumber = "" 
    LastName = "" 
    SSN = "" 
    ListContents = "" 
    ListContentsHQ = "" 
    Exit Sub 

err_I9_menu: 
    Call myprocess(False) 
    MsgBox Err.Number & " " & Err.Description 
    'MsgBox "The program has encountered an error and the data was NOT saved." 
    Exit Sub 

End Sub 

我不断收到ODBC调用错误。这些权限都是正确的，前面的一段代码在I9和Hq日志有单独表的地方工作。当有人提交一组包含特定信息的文件时，将调用该例程。

Answer 1

我解决了这个通过重新创建表的SQL，而不是向上调整其进出的。

Answer 2

这里只是一个猜测，但我认为你有一个错误，导致分配一个NULL到必填字段。

更改 “Locaton”：

rst.Fields("Site") = DLookup("Folder", "Locaton", "Loc_ID='" & Forms!frmUtility!Site & "'") 

要 “位置”：

rst.Fields("Site") = DLookup("Folder", "Location", "Loc_ID='" & Forms!frmUtility!Site & "'") 

---

排除故障3146 ODBC错误某些一般性的建议：DAO有一个Errors collection通常包含更具体的信息对于ODBC错误。以下是查看内容的快速和肮脏的方法。我有一个标准的错误处理模块中的这种更精细的版本，我包括我所有的计划：

Dim i As Long 
For i = 0 To Errors.Count - 1 
    Debug.Print Errors(i).Number, Errors(i).Description 
Next i