Private Sub Command1_Click()
Dim cat As ADOX.Catalog
Dim tbl As ADOX.Table
Dim sDBFrom As String
Dim sDBTo As String
Dim sql As String
Dim cnn As New ADODB.Connection
sDBFrom = "D:\TEST\From.mdb"
sDBTo = "D:\TEST\To.mdb"
'check to see if the database exist. if not create it.
If Dir(sDBTo) = "" Then
'database does not exist, make the database
Set cat = New ADOX.Catalog
cat.Create "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & sDBTo
Set cat = Nothing
End If
'setup db connection
cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & sDBFrom
Set cat = New ADOX.Catalog
Set cat.ActiveConnection = cnn
'copy all the tables using SQL and Execute
For Each tbl In cat.Tables
Debug.Print tbl.Name & " : " & tbl.Type
'Make sure this is a table and not a query / view
If UCase(tbl.Type) = "TABLE" Then
'make sure that you do not try to create the system tables,
'cause they will already be in the db
If UCase(Left(tbl.Name, 4)) <> "MSYS" Then
sql = "SELECT * INTO " & tbl.Name & " IN '" & sDBTo & "' FROM " & tbl.Name
cnn.Execute sql
End If
End If
Next tbl
'close the connection
Set cat = Nothing
Set cnn = Nothing
MsgBox "Import finished", vbInformation
End Sub