質問をすることでしか得られない、回答やアドバイスがある。

15分調べてもわからないことは、質問しよう!

ただいまの
回答率

89.98%

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

解決済

回答 2

投稿

  • 評価
  • クリップ 0
  • VIEW 2,322

kamiyui_bidan

score 35

下記のコードを、マクロをテキスト出力したいaccdbに
書いて、そのaccdbのマクロは出力できるのですが、
ファイルが数10ファイルあるので、できれば、1つの
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は実行できなくなる可能性が高い

  • 気になる質問をクリップする

    クリップした質問は、後からいつでもマイページで確認できます。

    またクリップした質問に回答があった際、通知やメールを受け取ることができます。

    クリップを取り消します

  • 良い質問の評価を上げる

    以下のような質問は評価を上げましょう

    • 質問内容が明確
    • 自分も答えを知りたい
    • 質問者以外のユーザにも役立つ

    評価が高い質問は、TOPページの「注目」タブのフィードに表示されやすくなります。

    質問の評価を上げたことを取り消します

  • 評価を下げられる数の上限に達しました

    評価を下げることができません

    • 1日5回まで評価を下げられます
    • 1日に1ユーザに対して2回まで評価を下げられます

    質問の評価を下げる

    teratailでは下記のような質問を「具体的に困っていることがない質問」、「サイトポリシーに違反する質問」と定義し、推奨していません。

    • プログラミングに関係のない質問
    • やってほしいことだけを記載した丸投げの質問
    • 問題・課題が含まれていない質問
    • 意図的に内容が抹消された質問
    • 広告と受け取られるような投稿

    評価が下がると、TOPページの「アクティブ」「注目」タブのフィードに表示されにくくなります。

    質問の評価を下げたことを取り消します

    この機能は開放されていません

    評価を下げる条件を満たしてません

    評価を下げる理由を選択してください

    詳細な説明はこちら

    上記に当てはまらず、質問内容が明確になっていない質問には「情報の追加・修正依頼」機能からコメントをしてください。

    質問の評価を下げる機能の利用条件

    この機能を利用するためには、以下の事項を行う必要があります。

回答 2

+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)

投稿

編集

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2018/08/08 13:39

    迅速な回答、ありがとうございます。
    教えていただいたコードを試したところ、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

    キャンセル

checkベストアンサー

0

Set Containers = CurrentDb.ContainersCurrentDbは開いている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.AllMacrosFor 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

投稿

編集

  • 回答の評価を上げる

    以下のような回答は評価を上げましょう

    • 正しい回答
    • わかりやすい回答
    • ためになる回答

    評価が高い回答ほどページの上位に表示されます。

  • 回答の評価を下げる

    下記のような回答は推奨されていません。

    • 間違っている回答
    • 質問の回答になっていない投稿
    • スパムや攻撃的な表現を用いた投稿

    評価を下げる際はその理由を明確に伝え、適切な回答に修正してもらいましょう。

  • 2018/08/08 13:41

    迅速な回答、ありがとうございます。
    教えていただいたコードを試したところ、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

    キャンセル

  • 2018/08/08 15:33

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

    キャンセル

  • 2018/08/08 15:57

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

    キャンセル

  • 2018/08/08 16:02

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

    キャンセル

15分調べてもわからないことは、teratailで質問しよう!

  • ただいまの回答率 89.98%
  • 質問をまとめることで、思考を整理して素早く解決
  • テンプレート機能で、簡単に質問をまとめられる