Hjælp til at sætte tæller og hourglaas on/of

Private Sub Command70_Click()

Dim db1 As Database
Dim db2 As Database
Dim tdf As TableDef
Dim tdf2 As TableDef
Dim TableCopy As Boolean

Set db1 = CurrentDb
Set db2 = OpenDatabase("c:\testDB.mdb")

With db1
For Each tdf In .TableDefs
    TableCopy = True
    With db2
        For Each tdf2 In .TableDefs
        If tdf.Name = tdf2.Name Then
        TableCopy = False
        End If
        Next tdf2
    End With
   
    If TableCopy Then
    DoCmd.TransferDatabase acExport, "Microsoft Access", db2.Name, acTable, tdf.Name, tdf.Name, 0
    End If

Next
End With


End Sub

Statusbar kræver en del mere (formular + smart kode), men resten får du her:
Vær dog opmærksom på at AntalTabeller også inkluderer systemtabeller (8-10 stykker), som er indeholdt i db1.tabledefs.


Dim db1 As Database
Dim db2 As Database
Dim tdf As TableDef
Dim tdf2 As TableDef
Dim TableCopy As Boolean
Dim AntalTabeller as Long
DIm AntalKopieret As Long

docmd.Hourglass true

Set db1 = CurrentDb
Set db2 = OpenDatabase("c:\testDB.mdb")

AntalTabeller = db2.Tabledefs.Count
With db1
For Each tdf In .TableDefs
    TableCopy = True
    With db2
        For Each tdf2 In .TableDefs
        If tdf.Name = tdf2.Name Then
        TableCopy = False
        End If
        Next tdf2
    End With
   
    If TableCopy Then
        AntalKopieret = AntalKopieret + 1
        DoCmd.TransferDatabase acExport, "Microsoft Access", db2.Name, acTable, tdf.Name, tdf.Name, 0
    End If

Next
End With

Docmd.Hourglass false
Msgbox AntalKopieret & " tabeller ud af de " & AntalTabeller & " mulige blev oprettet!", vbinformation, "Kopiering afsluttet!"

End Sub

tak for hjælpen