Dim dbsSource As Database, objDBObject As Object   
Dim i As Byte   
Set dbsSource = OpenDatabase(FilePath)  
For i =  1  To  7                                                                  'Начало копирования объектов  
    For Each objDBObject In dbsSource.Containers(i).Documents  
        If GetObjType(i) = 16 Then Exit For                       'Неизвестный объект   
        If i =  7  Then                                                            'Пошел табличный контейнер  
            If objDBObject.AllPermissions = dbsSource.Containers(i).AllPermissions Then  
                                                                                       'Отсеиваем системные таблицы    
                                                                                       'анализируюя параметры доступа   
                If objDBObject.Properties.count > 12 Then     'Это запрос   
                    DoCmd.TransferDatabase acImport,  "Microsoft Access" , FilePath, _  
                    GetObjType(i +  1 ), objDBObject.Name, objDBObject.Name  
                Else                                                                  'Это таблица   
                    DoCmd.TransferDatabase acImport, "Microsoft Access", FilePath, _  
                    GetObjType(i), objDBObject.Name, objDBObject.Name  
                End If   
            End If   
        Else                                                                          'Не таблица  
            DoCmd.TransferDatabase acImport,  "Microsoft Access" , FilePath, _  
            GetObjType(i), objDBObject.Name, objDBObject.Name  
        End If  
    Next objDBObject  
Next i  
Set dbsSource = Nothing  
  
Public Function GetObjType(n As Byte) As Long  
    Select Case n  
        Case  1   
            GetObjType =  2           'acForm  
        Case 2  
            GetObjType = 5          'acModule  
        Case  4   
            GetObjType =  3           'acReport  
        Case 5  
            GetObjType = 4          'acMacro  
        Case  7   
            GetObjType =  0           'acTable  
        Case 8  
            GetObjType = 1          'acQuery  
        Case Else  
            GetObjType =  16          'Неизвестный объект  
    End Select  
End Function