errors importing ODBC database


No replies
jme
jme's picture
User offline. Last seen 14 weeks 4 days ago. Offline
Joined: 11/07/2008

Option Compare Database
Option Explicit

Public Sub ImportAllODBCTables()
On Error GoTo lblErr
Dim db As Database, rs As New ADODB.Recordset, strCurrTable As String
Set db = DBEngine(0)(0)
rs.Open "_ImportFailures", CurrentProject.Connection, adOpenDynamic, adLockOptimistic
Do While Not rs.EOF
strCurrTable = Mid(rs("Object Name"), 5)
'Only run if table doesn't already exist
If Not DoesTableExists(strCurrTable, db) Then
If importODBCTable("dbo." & strCurrTable) Then
rs("reimported") = True
Else
rs("Failure Reason") = "Tried again at " & Now() & " but STILL couldn't import " & strCurrTable & "!!!"
End If
rs("Failure Reason") = strCurrTable & " alread imported"
End If
rs("time") = Now()
rs.Update
Loop
lblExit:
Set rs = Nothing
warns True
Exit Sub
lblErr:
Select Case Err
Case 0
Case Else
errmsg
End Select
Resume lblExit
Resume
End Sub

'test on dbo_TargetSiteLookup
Public Function importODBCTable(strTable As String) As Boolean
On Error GoTo lblErr
Dim strConn As String, strImportedTable As String, nPOS As Integer
nPOS = InStr(strTable, ".")
If nPOS > 0 Then
strImportedTable = Mid(strTable, nPOS + 1)
Else
strImportedTable = strTable
End If

strConn = "ODBC;DSN=someodbcconn;APP=Microsoft Office 2003;WSID=mysystemname;DATABASE=TheDB;"

'DoCmd.TransferDatabase acImport, "ODBC Database", strConn, acTable, "dbo.TargetSiteLookup", "TargetSiteLookup1"
DoCmd.TransferDatabase acImport, "ODBC Database", strConn, acTable, strTable, strImportedTable, False

lblExit:
warns True
Exit Function
lblErr:
Select Case Err
Case 0
Case Else
errmsg
End Select
Resume lblExit
Resume
End Function