Using TransferDatabase Import

  • Thread starter Thread starter Red
  • Start date Start date
R

Red

If there a way to loop through and import all tables in an ODBC database
when using TransferDatabase.

I need to backup an accounts database (Multisoft) on a monthly basis which
consists of 70+ tables and if possible want to avoid manually coding the
import of each. The manual route can be seen in the code below.

DoCmd.TransferDatabase acImport, "ODBC Database", "ODBC;DSN=HTA_AA",
acTable, _
"jcjobdet", strShortYear & "/" & txtMonth & "_" & "JCJOBDET"

Really appreciate all help.
 
Here are 3 procedures that may help with ODBC linking:


Public Sub LinkAllODBCTables(strDSN As String)
Dim dbs As Database
Dim dbsODBC As Database
Dim tdfODBC As TableDef, tdfAccess As TableDef
Dim connectStr As String, linkname As String

If IsNull(strDSN) Then
connectStr = "OBDC;"
linkname = ""
Else
connectStr = "ODBC;DSN=" & strDSN
linkname = strDSN
End If

Set dbs = CurrentDb
Set dbsODBC = OpenDatabase(linkname, dbDriverCompleteRequired, False,
connectStr)

For Each tdfODBC In dbsODBC.TableDefs
If Left(tdfODBC.Name, 4) = "dbo." Then
'It is a SQL Server Table
'If Left(tdfODBC.Name, 7) <> "dbo.sys" Then
'it is not a SQL Server system table so link to it.
Set tdfAccess = dbs.CreateTableDef(Mid(tdfODBC.Name, 5))
'End If
Else
Set tdfAccess = dbs.CreateTableDef(tdfODBC.Name)
End If

tdfAccess.Connect = dbsODBC.Connect

tdfAccess.SourceTableName = tdfODBC.Name
dbs.TableDefs.Append tdfAccess
Next

Set dbsODBC = Nothing
Set dbs = Nothing

End Sub

This code deletes all linked ODBC tables.
Try swapping dbAttachedODBC with dbAttachedTable for removing linked Access
tables.

Public Sub DeleteODBCTableNames()
On Error GoTo Err_DeleteODBCTableNames

Dim dbs As Database, tdf As TableDef, I As Integer
Set dbs = CurrentDb
For I = dbs.TableDefs.Count - 1 To 0 Step -1
Set tdf = dbs.TableDefs(I)
If (tdf.Attributes And dbAttachedODBC) Then
dbs.TableDefs.Delete (tdf.Name)
End If
Next I

dbs.Close
Set dbs = Nothing

Exit_DeleteODBCTableNames:
Exit Sub

Err_DeleteODBCTableNames:
MsgBox ("Error # " & str(Err.Number) & " was generated by " & Err.Source
& Chr(13) & Err.Description)
Resume Exit_DeleteODBCTableNames

End Sub



Sub ChangeODBC(mDSN As String, mDATABASE As String)
On Error Resume Next
Dim dbs As Database, tdf As TableDef, prpLoop As Property
Set dbs = CurrentDb
For Each tdf In dbs.TableDefs
If (tdf.Attributes And dbAttachedODBC) Then
For Each prpLoop In tdf.Properties
If prpLoop.Name = "Connect" Then
prpLoop.Value = "ODBC;DSN=" & mDSN & ";UID=id;PWD=pwd;DATABASE="
& mDATABASE & ";"
End If
Next prpLoop
tdf.RefreshLink
End If
Next tdf
dbs.Close
Set dbs = Nothing
End Sub
 
I prefer this method over the other one I posted.
You should be able to understand the concept and apply it to your specific
situation.

I use this procedure to re-create links to SQL Server.
(This eliminates the need to re-name all the tables to strip out dbo_ and it
allows you to point to different versions of the same database easily.)
There is a local Access table (tblODBCTables) that contains the table names
I want to link to on the Server.
Note: the source table name needs the dbo. prefix which is in the code. The
linked table name usualy omits this. .

Public Sub LinkSQLServerTables(strDSN As String, strDatabase)
On Error GoTo Err_LinkSQLServerTables

Dim dbs As Database, rs As Recordset, tdfAccess As TableDef
Dim dbsODBC As Database, strConnect As String

If strDSN = "" Then
MsgBox "You must supply a DSN in order to link tables."
Exit Sub
Else
strConnect = "ODBC;DSN=" & strDSN & ";UID=User;PWD=password;DATABASE=" &
strDatabase & ";"
End If

SysCmd acSysCmdSetStatus, "Connecting to SQL Server..."

Call DeleteODBCTableNames

Set dbs = CurrentDb
Set rs = dbs.OpenRecordset("tblODBCTables")
Set dbsODBC = OpenDatabase("", False, False, strConnect)

Do While Not rs.EOF
Set tdfAccess = dbs.CreateTableDef(rs![LinkTablename], dbAttachSavePWD)
tdfAccess.Connect = dbsODBC.Connect
tdfAccess.SourceTableName = dbsODBC.TableDefs("dbo." &
rs![LinkTablename]).Name
dbs.TableDefs.Append tdfAccess
rs.MoveNext
Loop

rs.Close
Set rs = Nothing
Set dbsODBC = Nothing
Set dbs = Nothing

Exit_LinkSQLServerTables:
SysCmd acSysCmdClearStatus
Exit Sub

Err_LinkSQLServerTables:
MsgBox ("Error # " & Str(Err.Number) & " was generated by " & Err.Source
& Chr(13) & Err.Description)
Resume Exit_LinkSQLServerTables

End Sub


'This procedure deletes all linked ODBC table names in an mdb.
Public Sub DeleteODBCTableNames()
On Error GoTo Err_DeleteODBCTableNames

Dim dbs As Database, tdf As TableDef, I As Integer
Set dbs = CurrentDb
For I = dbs.TableDefs.Count - 1 To 0 Step -1
Set tdf = dbs.TableDefs(I)
If (tdf.Attributes And dbAttachedODBC) Then
dbs.TableDefs.Delete (tdf.Name)
End If
Next I

dbs.Close
Set dbs = Nothing

Exit_DeleteODBCTableNames:
Exit Sub

Err_DeleteODBCTableNames:
MsgBox ("Error # " & Str(Err.Number) & " was generated by " & Err.Source
& Chr(13) & Err.Description)
Resume Exit_DeleteODBCTableNames

End Sub
 
Back
Top