Transfer tables between secured external DBs using TransferDatabase
rdemyan
secured DB to a database created in the code. I would like to kind of
use automation, although OpenCurrentDatabase apparantly can't be made
to work with secured databases. I saw a post where someone from MS
recommended GetObject.
My code below has two problems. I keep getting an unspecified error on
the GetObject line. So, I've temporarily used On Error Resume Next
before that line (per MS recommendation).
But I'm also getting an error on the TransferDatabase line: Error 3045
"Could not use DestinationDB; file already in use. The posted code is
just a start so suggestions, comments are welcome. Note: I had some
trouble pasting this code in; so some of the line breaks don't appear
correct but they do work correctly in the actual code.
Code:
--------------------------------------------------------------------------------
Dim varAccess, strShell As String, strFilePath As String
Dim accObj As New Access.Application
Dim db As DAO.Database, tdf As DAO.TableDef, dbNew As DAO.Database
SourceDB = "C:\Test\MyDB.mdb"
DestinationDB = CurrentProject.Path & "\" & "TestCopyTransferDB" &
".mdb"
'Create the new blank database
Set dbNew = CreateDatabase(DestinationDB, dbLangGeneral)
'Use shell to open the source database
strFilePath = SysCmd(acSysCmdAccessDir)
strShell = Chr(34) & strFilePath & "msaccess.exe" & Chr(34) & " " &
Chr(34) & SourceDB & Chr(34) & _
"/WRKGRP " & Chr(34) & Forms!HiddenForm.Workgroup_File & Chr(34) & _
"/USER " & Chr(34) & "admin" & Chr(34) & _
"/PWD " & Chr(34) & "password" & Chr(34)
varAccess = Shell(strShell, vbMinimizedNoFocus)
DoEvents
On Error Resume Next
Set accObj = GetObject(SourceDB)
On Error GoTo 0
Set db = OpenDatabase(SourceDB)
For Each tdf In db.TableDefs
If Left(tdf.Name, 4) <> "Msys" Then
accObj.DoCmd.TransferDatabase acExport, "Microsoft Access",
DestinationDB, acTable, tdf.Name, tdf.Name
End If
Next tdf
accObj.CloseCurrentDatabase
Set accObj = Nothing
db.Close
Set db = Nothing
dbNew.Close
Set dbNew = Nothing