ＶBA This Workbookモジュールを別ファイルにコピーする方法

お詳しい方　　御教授をお願いします。

相談事項
エクスポートした　VBAプログラムが格納されたThis Workbookを
指定したフォルダに格納されている全エクセルファイルにコピーを行いたい。
しかし、下記のコードで実行を行おうとすると
This Work book1というモジュールが作成されコピーがうまくいかない
どのようにコードを変更すればいいのか、アドバイスを頂けないでしょうか。

コード
Sub モジュール追加釦_Click()

'インポートされるブックが存在するフォルダ

Const TARGET_XLS_FOLDER = "変更予定のフォルダURL"



'インポートするモジュールが存在するフォルダ

Const TARGET_MODULE_FOLDER = "This Workbook　保管フォルダURL"

Dim fso As FileSystemObject

Set fso = New FileSystemObject



'ブックが存在するフォルダを取得する

Dim xlsfolder As Folder

Set xlsfolder = fso.GetFolder(TARGET_XLS_FOLDER)

Dim xlsfile As File



'モジュールが存在するフォルダを取得する

Dim mdlfolder As Folder

Set mdlfolder = fso.GetFolder(TARGET_MODULE_FOLDER)

Dim mdlfile As File





'対象フォルダ内のファイルをループさせる

For Each xlsfile In xlsfolder.Files

'拡張子がエクセルのマクロ有効ブックの場合、このブックは対象外とする

If fso.GetExtensionName(xlsfile.Path) = "xlsm" And xlsfile.Path <> ThisWorkbook.Path Then

Dim wb As Workbook

Set wb = Workbooks.Open(xlsfile.Path)



'モジュールファイルをループさせる

For Each mdlfile In mdlfolder.Files

If fso.GetExtensionName(mdlfile.Path) = "bas" _

Or fso.GetExtensionName(mdlfile.Path) = "frm" _

Or fso.GetExtensionName(mdlfile.Path) = "cls" Then

'既存のモジュールがあれば削除

Call removeObj(wb, fso.GetBaseName(mdlfile))

'新しいモジュールを追加する

Call wb.VBProject.VBComponents.Import(mdlfile)

End If

Next





'ブックを保存して閉じる

wb.Save





wb.Close

End If

Next



'オブジェクトを開放

Set fso = Nothing



End Sub

No.1 回答者： fujillin 回答日時： 2022/09/14 11:20

こんにちは

説明がはっきりしないのと、コードを見ても意図不明の部分がいろいろあってよくわかりませんけれど・・

ThisWorkbookモジュールにコードをコピペしたいのではないかと想像しました。
確かめてはいませんけれど、インポートは標準モジュールにモジュールを追加するので、Workbookモジュールには記入できないのではないでしょうか？

もしそうであるなら、直接内容をコピペする方が簡単だと思います。
元となるブックをSourceBook、コピペ先をDestinationBookとするなら・・

一旦、元のコードをテキストで取得しておいて、
With SourceBook.VBProject.VBComponents("ThisWorkbook").CodeModule
　CodeText = .Lines(1, .countoflines)
End With

まるっとコピペで良いのなら、対象モジュールをクリアしてからペースト。
With DestinationBbook.VBProject.VBComponents("ThisWorkbook").CodeModule
　.DeleteLines 1, .countoflines
　.InsertLines 1, CodeText
End With
みたいなことを、各ブックで繰り返せばできると思いますけれど・・・


※ 内容や意味が違っていたなら、スルーしてください。

この回答へのお礼

ありがとうございました　参考にさせていただきます

お礼日時：2022/09/14 12:50