Accessマクロをテキスト出力したい

Question

下記のコードを、マクロをテキスト出力したいaccdbに
書いて、そのaccdbのマクロは出力できるのですが、
ファイルが数10ファイルあるので、できれば、１つの
accdbから他のaccdbのマクロを出力できるようにしたいです。

そのような方法はありますでしょうか？
※ファイル数の分だけ繰り返す、という処理の書き方だけは分かっています

Dim Containers As DAO.Containers
Dim Container As DAO.Container
Dim Document As DAO.Document

 Set Containers = CurrentDb.Containers 
Set Container = Containers("Scripts")

For Each Document In Container.Documents
    SaveAsText ObjectType:=AcObjectType.acMacro, _
    			ObjectName:=Document.Name, _
                fileName:="C:\" & Document.Name & ".txt"
Next

【環境】
Access2010のVBA、Win7
※因みに、今はPCの管理者権限があるが、近いうちに標準ユーザに
なるので、VBScriptは実行できなくなる可能性が高い

Answer 1

Currentdbではなくて、他のDBを参照するようにすればイケると思います。
ファイル名若しくは、dbをパラメータにした関数にすれば、共通化出来るかと。

Dim Containers As DAO.Containers
Dim Container As DAO.Container
Dim Document As DAO.Document
Dim db As DAO.Databese

Set db = OpenDatabase("対象ファイルのフルパス") 
Set Containers = db.Containers 
Set Container = Containers("Scripts")

For Each Document In Container.Documents
  SaveAsText ObjectType:=AcObjectType.acMacro, _
  ObjectName:=Document.Name, _
  fileName:="C:\" & Document.Name & ".txt"
Next

OpenDatabaseメソッド ： DAOリファレンス - DAO入門講座
Workspace.OpenDatabase メソッド (DAO)

Comments

[kamiyui_bidan]

迅速な回答、ありがとうございます。
教えていただいたコードを試したところ、SaveAsTextの行で "指定した名前および型のオブジェクトは、カレントデータベースには存在しません"　というエラーが出てしまいましたので、下記のように変更して出力できました。

下記のように書くより、ここはこうした方がいい、
みたいな点があれば、ご指摘いただけると幸いです。

Sub ExportMacro()
Dim OutDir As String
Dim Containers As DAO.Containers
Dim Container As DAO.Container
Dim Document As DAO.Document
Dim db As DAO.Database
Dim appAccess As Access.Application '★
Dim strDB As String '★

strDB = "Z:\sample.accdb" '★
OutDir = "C:\Users\ユーザー\Desktop\_tmp\"

Set db = OpenDatabase(strDB)
Set Containers = db.Containers
Set Container = Containers("Scripts")
Set appAccess = CreateObject("Access.Application") '★

'マクロの数だけ繰り返し
For Each Document In Container.Documents
appAccess.OpenCurrentDatabase strDB '★
appAccess.Application.SaveAsText ObjectType:=AcObjectType.acMacro, _
ObjectName:=Document.Name, _
fileName:=OutDir & Document.Name & ".txt"

'SaveAsText ObjectType:=AcObjectType.acMacro, _
ObjectName:=Document.Name, _
fileName:=OutDir & Document.Name & ".txt"
Next

db.Close: Set db = Nothing
Set appAccess = Nothing

MsgBox "処理終了"
End Sub

Answer 2

Set Containers = CurrentDb.ContainersのCurrentDbは開いているAccdbのDataBaseという意味だから、ここを、下記のように他のAccdbファイルを開いて使用すればいいでしょう。

Dim Db As DAO.DataBase
Set Db = OpenDatabase("accdbファイルのパス")
Set Containers = Db.Containers

'中略

Db.Close: Set Db = Nothing

訂正

SaveAsTextメソッドは、Access.Applicationのメソッドなので、下記のコードになりますね。
マクロ名は、CurrentProject.AllMacrosをFor Eachでループさせれば取得できますので、 OpenDatabaseは不要です。

Sub ExportMacro()
    Dim OutDir As String
    Dim acObj As AccessObject
    Dim appAccess As Access.Application
    Dim strDB As String

    strDB = "C:\TEST1\Database1.accdb"
    OutDir = "C:\TEST1\"

    Set appAccess = CreateObject("Access.Application")
    appAccess.OpenCurrentDatabase strDB
    
    'マクロの数だけ繰り返し
    For Each acObj In appAccess.CurrentProject.AllMacros
        appAccess.Application.SaveAsText ObjectType:=AcObjectType.acMacro, _
                                         ObjectName:=acObj.Name, _
                                         FileName:=OutDir & acObj.Name & ".txt"
    Next
    appAccess.CloseCurrentDatabase
    appAccess.Quit
    Set appAccess = Nothing

    MsgBox "処理終了"
End Sub

Comments

[kamiyui_bidan]

迅速な回答、ありがとうございます。
教えていただいたコードを試したところ、SaveAsText行で
"指定した名前および型のオブジェクトは、カレントデータベースには存在しません"　
というエラーが出てしまいましたので、下記のように変更して出力できました。

下記のように書くより、ここはこうした方がいい、
みたいな点があれば、ご指摘いただけると幸いです。

Sub ExportMacro()
Dim OutDir As String
Dim Containers As DAO.Containers
Dim Container As DAO.Container
Dim Document As DAO.Document
Dim db As DAO.Database
Dim appAccess As Access.Application '★
Dim strDB As String '★

strDB = "Z:\sample.accdb" '★
OutDir = "C:\Users\ユーザー\Desktop\_tmp\"

Set db = OpenDatabase(strDB)
Set Containers = db.Containers
Set Container = Containers("Scripts")
Set appAccess = CreateObject("Access.Application") '★

'マクロの数だけ繰り返し
For Each Document In Container.Documents
appAccess.OpenCurrentDatabase strDB '★
appAccess.Application.SaveAsText ObjectType:=AcObjectType.acMacro, _
ObjectName:=Document.Name, _
fileName:=OutDir & Document.Name & ".txt"

'SaveAsText ObjectType:=AcObjectType.acMacro, _
ObjectName:=Document.Name, _
fileName:=OutDir & Document.Name & ".txt"
Next

db.Close: Set db = Nothing
Set appAccess = Nothing

MsgBox "処理終了"
End Sub

[ExcelVBAer]

appAccess を最後にNothingしてますが、
その前に .Quit で閉じないとプロセスが残ってるのでは？？

[kamiyui_bidan]

ご指摘、ありがとうございます。
おっしゃる通り、プロセスが残ってましたので、Nothingの前にappAccess.Quit　を入れるようにしました。

[hatena19]

冗長な部分があるので、それを排除したコードを回答に追記しましたので、参考にしてください。