Accessのオブジェクトインポート


複数のmdbAccessのオブジェクトを1つのmdbにインポートするVBAです。
Modulesを作成し、以下のコードを貼り付けてください。

Public Function mdb_import_main()

Dim FileSystem As Object
    
    '現在格納されているオブジェクトの削除を行う
    Call Delete_MyObjects
    
    'インポート元MDBの格納フォルダの指定
    targetPath = "D:\imports_test\新しいフォルダ\"

    'このディレクトリのファイル一覧を取得する
    Set FileSystem = CreateObject("Scripting.FileSystemObject")
    Set targetFolder = FileSystem.getFolder(targetPath)
    Set fileList = targetFolder.Files

    'ファイルの終端までループ
    For Each wkFile In fileList
        
        'ファイルがAccessであればインポートを行う
        If wkFile.Type = "Microsoft Office Access 2007 データベース" Then
            Call Forms_Delete_And_Import(targetPath & "\" & wkFile.Name)
        End If
    Next

    MsgBox "インポートが完了しました。"
    
End Function

'
'   指定したDBのオブジェクトをインポートする
'
Private Function Forms_Delete_And_Import(ByVal srcMdb As String)

    Dim DB1 As Database
    Dim DB2 As Database
    Dim CN1 As Container
    Dim DC1 As Document
    
    'CurrentDBとコピー元DBをオープン
    Set DB1 = CurrentDb()
    Set DB2 = OpenDatabase(srcMdb)
    

    'Form,Modles,Reportsのインポートを行う
    For Each CN1 In DB2.Containers
        If CN1.Name = "Forms" Then
            For Each DC1 In CN1.Documents
          
                DoCmd.TransferDatabase acImport, "Microsoft Access", DB2.Name, acForm, DC1.Name, DC1.Name
                RefreshDatabaseWindow
                
            Next
        ElseIf CN1.Name = "Modules" Then
            For Each DC1 In CN1.Documents
          
                DoCmd.TransferDatabase acImport, "Microsoft Access", DB2.Name, acModule, DC1.Name, DC1.Name
                RefreshDatabaseWindow
                
            Next
        ElseIf CN1.Name = "Reports" Then
            For Each DC1 In CN1.Documents
          
                DoCmd.TransferDatabase acImport, "Microsoft Access", DB2.Name, acReport, DC1.Name, DC1.Name
                RefreshDatabaseWindow
                
            Next
        End If
    Next
    
    'CurrentDBとコピー元DBをクローズ
    DB1.Close
    DB2.Close

End Function

'
'   CurrentDBのオブジェクトを削除する
'
Private Function Delete_MyObjects()
    Dim DB1 As Database
    Dim CN1 As Container
    
    'CurrentDBのオープン
    Set DB1 = CurrentDb()
    
    'Form,Modles,Reportsの削除を行う
    For Each CN1 In DB1.Containers
    
        If CN1.Name = "Forms" Then
            For Each DC1 In CN1.Documents
          
                DoCmd.DeleteObject acForm, DC1.Name
                RefreshDatabaseWindow
                
            Next
        ElseIf CN1.Name = "Modules" Then
            For Each DC1 In CN1.Documents
                
                If DC1.Name = "Module1_harada" Then
                    '消したくないオブジェクトはここで指定
                Else
                
                    DoCmd.DeleteObject acModule, DC1.Name
                    RefreshDatabaseWindow
                End If
            Next
        ElseIf CN1.Name = "Reports" Then
            For Each DC1 In CN1.Documents
          
                DoCmd.DeleteObject acReport, DC1.Name
                RefreshDatabaseWindow
                
            Next
        End If
        
    Next


End Function


動作確認環境:Windows XP sp2,Access 2007