Custom collection from TableDefs collection (1 Viewer)

[NauticalGent]

Greetings everyone,

I have about 10 tables that I need to export to an external DB - Linking is not an option

I think if I made a collection of Tables then I could do something like:

For Each tdf In myCollectionOfTables
        DoCmd.TransferDatabase acExport, "Microsoft Access", "\\ExternalDb", _
                                   acTable, tdf.Name, tdf.Name, False
Next tdf

I assume this would be the best way to do this - I thought of making a table to hold the table's names and then loop through a recordset but thought this way would be better.

I have tried to add the tables but I keep getting syntax errors - is this even possible?

As always, I am open to suggestions and I thank you in advance!

 

[June7]

Tables collection includes system tables which you likely don't want to export.

What is exact error message?

And what is myCollectionOfTables set to?

The other db is already created?

An alternative is to use INSERT INTO SELECT. Example from my db:

'exports data to ConstructionExtract Access file
'copies file to zip folder
'opens Outlook and attaches file to msg and sends

Dim strZip As String
Dim strExtract As String

strZip = gstrBasePath & "Editing\ConstructionExtract.zip"
strExtract = gstrBasePath & "Editing\ConstructionExtract.accdb"

'delete records from ConstructionExtract tables
CurrentDb.Execute "DELETE FROM Bituminous IN '" & strExtract & "'"
CurrentDb.Execute "DELETE FROM BituminousMD IN '" & strExtract & "'"
CurrentDb.Execute "DELETE FROM Concrete IN '" & strExtract & "'"
CurrentDb.Execute "DELETE FROM Emulsion IN '" & strExtract & "'"
CurrentDb.Execute "DELETE FROM PGAsphalt IN '" & strExtract & "'"
CurrentDb.Execute "DELETE FROM SoilsAgg IN '" & strExtract & "'"
CurrentDb.Execute "DELETE FROM SampleInfo IN '" & strExtract & "'"
'insert records into ConstructionExtract tables
CurrentDb.Execute "INSERT INTO Bituminous IN '" & strExtract & "' SELECT * FROM ConstructionBIT;"
CurrentDb.Execute "INSERT INTO BituminousMD IN '" & strExtract & "' SELECT * FROM ConstructionBMD;"
CurrentDb.Execute "INSERT INTO Concrete IN '" & strExtract & "' SELECT * FROM ConstructionCONC;"
CurrentDb.Execute "INSERT INTO Emulsion IN '" & strExtract & "' SELECT * FROM ConstructionEMUL;"
CurrentDb.Execute "INSERT INTO PGAsphalt IN '" & strExtract & "' SELECT * FROM ConstructionPG;"
CurrentDb.Execute "INSERT INTO SoilsAgg IN '" & strExtract & "' SELECT * FROM ConstructionSA;"
CurrentDb.Execute "INSERT INTO SampleInfo IN '" & strExtract & "' SELECT * FROM ConstructionSampleInfo;"

'create empty zip folder
'found this on web, no idea what the Print line does but if it isn't there, this won't work
Open strZip For Output As #1
Print #1, "PK" & Chr$(5) & Chr$(6) & String(18, 0)
Close #1
'copy file into zip folder
Dim objApp As Object
Set objApp = CreateObject("Shell.Application")
'variable for source file doesn't seem to work in this line
'also double parens not in original example code but won't work without
objApp.NameSpace((strZip)).CopyHere gstrBasePath & "Editing\ConstructionExtract.accdb"

'open Outlook, attach zip folder, send e-mail
Dim appOutLook As Outlook.Application
Dim MailOutLook As Outlook.MailItem
Set appOutLook = CreateObject("Outlook.Application")
Set MailOutLook = appOutLook.CreateItem(olMailItem)
With MailOutLook
    .BodyFormat = olFormatRichText
    .To = "email address"
    ''.cc = ""
    ''.bcc = ""
    .Subject = "Central Materials Laboratory Data"
    .HTMLBody = "Construction data extract: " & Now
    .Attachments.add (strZip)
    .DeleteAfterSubmit = True 'to not retain in sent folder
    .Display
    ''.Send
End With

 

[NauticalGent]

I tried:

Dim colTables as New Collection
Dim db as DAO.DataBase
Dim tDef as DAO.TableDef

Set db = Currentdb

With colTables
    .Add(db.tDef("mytable")) 'this is where it all comes crashing down

 

[theDBguy]

Do you really need your own collection? You may be able to just use the TableDefs collection directly.

For Each tdf In db.TableDefs
    If tdf.Name="myTable" Then
        DoCmd.TransferDatabase...
    End If 
Next

Just a thought...

 

[June7]

DBguy got that suggestion in first. But to get an idea of what is in TableDefs consider this:

Sub ListTables()
Dim tdf As TableDef
For Each tdf In CurrentDb.TableDefs
    Debug.Print tdf.Name
Next
End Sub

Might want to review my earlier post which I edited before you replied.

 

[NauticalGent]

This would work if I wanted every non-system table - but I don't. I want a few select tables only.

error is 91 - Object variable or With block variable not set.

Definitely not doing something right when adding the table.

 

[Gasman]

I'd be one to put the names in a table and a flag to indicate whether to transfer or not.?
June7's code would go towards populating the table, then just mark those you want to transfer at the moment.?

 

[NauticalGent]

I even thought about adding a Description to the tables in question (like the Tag property in a form) and use that to distinguish the tables but that is a another red-ass I don't want to experience

 

[isladogs]

I was going to suggest adding a boolean field and selecting those you want to export.
Alternatively you could add an ...EXP alias to all tables you want to export (e.g. tblNameEXP)
Then filter for those tables with the alias.

Whichever way you do it you will probably need to use MSysObjects to create a temp table of all non-system table names in order to filter it

 

[NauticalGent]

Thanks all - so am I to understand that there is no way to add tables to a collection?

 

[The_Doc_Man]

OK, I'll take this from another direction. Error 91 means that, whatever step gets that error, the object it was trying to manage had not been properly defined. So open up the locals window to see if some locally defined object is "Nothing" at the time of the error. That will tell you what DIDN'T get defined, which might help you.

 

[June7]

Tables are already in a collection. Sure, you can create your own by why bother?

If table names have a suffix as suggested by Colin, I don't think would need to create a table of table names. The loop code would just have an If Then conditional.

If tdf.Name LIKE "*EXP" Then

Otherwise, build a table of table names you want to export and use a Recordset of that table in looping code. Or hard code the tables as in my earlier example.

 

[MajP]

Yes of course you can. Your code is wrong.
This does not makes sense

tDef("mytable")

Tdef is not set, and what is the purpose.
should be db.tabledefs("myTable")

 

[MajP]

Or

Set db = Currentdb
set tdef = db.tabledefs("mytable")
colTables.Add tdef,"mytable"

 

[NauticalGent]

Yes of course you can.

Great, thanks!

Your code is wrong.

Ya think!?!

Tdef is not set, and what is the purpose.
should be db.tabledefs("myTable")

Makes sense now that it has been pointed out!

Set db = Currentdb set tdef = db.tabledefs("mytable") colTables.Add tdef,"mytable"

Thanks, I will work this in and get back to you.

 

[MajP]

Also you may want to look at a dictionary object instead of a collection. Depending on the things you want to do, it may provide some advantages. Easy to check if something exists. Easy to get a collection of the keys.

 

[jdraw]

NG,

How many tables are involved? I agree with using the TableDefs provided by M$oft-- but I saw earlier you had mentioned a 5 year contract......

 

[NauticalGent]

Tables are already in a collection. Sure, you can create your own by why bother?

Good point and once I took a step back, it made perfect sense.

Also, thanks MajP - don't know why I thought I could use an object variable without setting it to something first.

I made a small temp table that holds the table names - easier to add to it rather than add fields to existing tables.

For the record, here is the code I came up with:

Public Sub ExportEDATables()
On Error GoTo error_handler

    Dim db As DAO.Database
    Dim rs As DAO.Recordset
    Dim strExtDB As String
    Dim tdef As DAO.TableDef

    Set db = CurrentDb
    Set rs = db.OpenRecordset("Select * from tblEDATables", dbOpenSnapshot)

    strExtDB = "\\MyPath\MyDB.accdb"

    With rs
        If Not .BOF And Not .EOF Then
            .MoveLast
            .MoveFirst
            While Not .EOF
                  Set tdef = db.TableDefs(.Fields("TableName"))
                DoCmd.TransferDatabase acExport, "Microsoft Access", strExtDB, _
                                        acTable, tdef.Name, tdef.Name, False
                .MoveNext
            Wend
        End If
    End With
   
exit_handler:
    On Error Resume Next
    rs.Close
    Set rs = Nothing
    Set tdef = Nothing
    Set db = Nothing
    Exit Sub

error_handler:
    MsgBox Error$
    Resume exit_handler
    Resume

End Sub

 

[NauticalGent]

but I saw earlier you had mentioned a 5 year contract......

 

[NauticalGent]

Also you may want to look at a dictionary object instead of a collection. Depending on the things you want to do, it may provide some advantages. Easy to check if something exists. Easy to get a collection of the keys.

Not sure what you mean by this? What is a dictionary object?