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

这里只是一个猜测，但我认为您有一个错字，导致将 Null 分配给必填字段。

更改“位置”：

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

Answer 2

我通过在 SQL 中重新创建表来解决这个问题，而不是从 Access 中扩大它的大小。

Answer 3

我的 3146 错误是由于我的 sql server 表上缺少主键引起的。它是通过定义一个主键然后通过链接表管理器刷新连接来解决的。