3146 ODBC-Aufruf fehlgeschlagen - Access 2010
Bitte untenstehenden Referenzcode ...
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
Ich erhalte immer wieder einen ODBC-Aufruffehler. Die Berechtigungen sind alle korrekt und der vorherige Code funktionierte, wenn separate Tabellen für die I9- und Hq-Protokolle vorhanden waren. Die Routine wird aufgerufen, wenn jemand eine Reihe von Dateien mit bestimmten Informationen übermittelt.