複数のmdbのAccessのオブジェクトを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