3146 ODBC Call Failed - Access 2010

问题:

Please reference code below...

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

I keep getting an ODBC call error. The permissions are all correct and the previous piece of code worked where there were separate tables for the I9 and Hq logs. The routine is called when someone submits a set of files with specific information.

回答1:

Just a guess here, but I'm thinking you've got a typo that's resulting in assigning a Null to a required field.

Change "Locaton":

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

To "Location":

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

---

Some general advice for troubleshooting 3146 ODBC Errors: DAO has an Errors collection which usually contains more specific information for ODBC errors. The following is a quick and dirty way to see what's in there. I have a more refined version of this in a standard error handling module that I include in all of my programs:

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

回答2:

I solved this by recreating the table in SQL instead of up-sizing it out of Access.

回答3:

My 3146 error was caused by the lack of primary key on my sql server table. It was resolved by defining a primary key and then refreshing the connection through Linked Table Manager.