Excel(エクセル)、Access(アクセス)からVBAのプログラムファイルを一括抽出する方法

VBCSharpDotNet
フォルダ内(含サブフォルダ)のExcel(エクセル)、Access(アクセス)ファイルのVBAソースコードの一括抽出プログラムコードを紹介いたします。

【タイトル】

Excel(エクセル)、Access(アクセス)からVBAのプログラムファイルを一括抽出する方法

【概要】

Excel(エクセル)、Access(アクセス)の1ファイルや数ファイルであれば、手作業でVBAプログラムソースを取得することも可能であるが、大量な複数ファイルであれば手作業でのVBAプログラムソースコードの抽出は非常に煩雑で時間も必要になってきます。そこでフォルダ内(含サブフォルダ)のExcel(エクセル)、Access(アクセス)ファイルのVBAソースコードの一括抽出プログラムコードを紹介いたします。

【サブタイトル】

「複数のExcel(エクセル)、Access(アクセス)からVBAソースコードを取得」
Excel(エクセル)、Access(アクセス)の1ファイルや数ファイルであれば、手作業でVBAプログラムソースを取得することも可能であるが、大量な複数ファイルであれば手作業でのVBAプログラムソースコードの抽出は非常に煩雑で時間も必要になってきます。そこでフォルダ内(含サブフォルダ)のExcel(エクセル)、Access(アクセス)ファイルのVBAソースコードの一括抽出プログラムコードを紹介いたします。

【注意点】

「Access(アクセス)からVBAソースコードを取得する際の注意点」
Accessの場合は、ファイルごとにVBAを取得するのではなく、起動しているAccessからVBAを取得しなければならない。
そのため、「Set VBProject = accessObj.VBE.ActiveVBProject」としてAccessオブジェクト(accessObj)そのものからプロジェクト(VBE.ActiveVBProject)を取得することがコツである。

【以下、VBAソースコードファイル抽出用の処理】

・エクセルマクロで実行して仕様します。
・出力先⇒プログラムファイル(*.bas,*.cls,*.frm)は、元ファイル(エクセルまたはアクセス)と同フォルダに出力されます。

‘【メイン呼び出し】ここから処理が始まります。

‘呼出し方
Sub Execute_All()
‘Excel用
Call GetSubDir(“C:\data_list”)
‘Access用
Call GetSubDir_ACC(“C:\data_list”, “accdb”)
‘旧Access用
Call GetSubDir_ACC(“C:\data_list”, “mdb”)
MsgBox (“完了”)
End Sub

■Excel用VBA■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■START

‘ パス一時格納用変数
Dim sFullPath As String

‘@機能 :指定フォルダのエクセルファイルのみを取得
‘@メモ :サブフォルダも検索
‘@拡張子:xlsm,xla,xlam
‘@仕様 :ルートフォルダを指定(例:C:\File_List)
Sub GetSubDir(Path As String)
Dim buf As String, f As Object
buf = Dir(Path & “\*.xl*”)
Do While buf <> “”

sFullPath = Path & “\” & buf

Cells(1, 1) = sFullPath

If Right(buf, 4) = “xlsm” Or Right(buf, 3) = “xla” Or Right(buf, 3) = “xlam” Then
Call ExportAll(sFullPath, buf)
End If

buf = Dir()
Loop
With CreateObject(“Scripting.FileSystemObject”)
For Each f In .GetFolder(Path).SubFolders
Call GetSubDir(f.Path)
DoEvents
Next f
End With
End Sub

‘@機能    :VBAに含まれるモジュールをファイル出力
‘@メモ    :出力ファイルフォーマット プリセット_モジュール名_ファイル名_.bas
‘@拡張子   :xlsm,xla,xlam
‘@出力拡張子 :*.cls,*.frm,*.bas
Sub ExportAll(ByVal sFPath As String, ByVal sName As String)
On Error GoTo myError
Dim module As VBComponent ‘// モジュール
Dim moduleList As VBComponents ‘// VBAプロジェクトの全モジュール
Dim extension ‘// モジュールの拡張子
Dim sPath ‘// 処理対象ブックのパス
Dim sFilePath ‘// エクスポートファイルパス
Dim TargetBook ‘// 処理対象ブックオブジェクト

Dim bkCurrent As Workbook

‘// Open Book
Set bkCurrent = Workbooks.Open(sFPath, False, Password:=”PASSWORD”)
‘ ‘// ブックが開かれていない場合は個人用マクロブック(personal.xlsb)を対象とする
‘ If (Workbooks.Count = 1) Then
‘ Set TargetBook = ThisWorkbook
‘ ‘// ブックが開かれている場合は表示しているブックを対象とする
‘ Else
‘ Set TargetBook = ActiveWorkbook
‘ End If

Set TargetBook = bkCurrent

sPath = TargetBook.Path

‘// 処理対象ブックのモジュール一覧を取得
Set moduleList = TargetBook.VBProject.VBComponents

‘// VBAプロジェクトに含まれる全てのモジュールをループ
For Each module In moduleList
‘// クラス
If (module.Type = vbext_ct_ClassModule) Then
extension = “cls”
‘// フォーム
ElseIf (module.Type = vbext_ct_MSForm) Then
‘// .frxも一緒にエクスポートされる
extension = “frm”
‘// 標準モジュール
ElseIf (module.Type = vbext_ct_StdModule) Then
extension = “bas”
‘// その他
Else
‘// エクスポート対象外のため次ループへ
GoTo CONTINUE
End If

‘// エクスポート実施
sFilePath = sPath & “\” & module.Name & “_” & Replace(sName, “.”, “”) & “_” & “.” & extension
Call module.Export(sFilePath)

‘// 出力先確認用ログ出力
Debug.Print sFilePath
CONTINUE:
Next
TargetBook.Close (False)
myError:
End Sub

‘■Access用VBA■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■START

‘ パス一時格納用変数
Dim sFullPath As String

‘@機能 :指定フォルダのAccessファイルのみを取得
‘@メモ :サブフォルダも検索
‘@拡張子:xlsm,xla,xlam
‘@仕様 :ルートフォルダを指定(例:C:\File_List)
‘@仕様 :Access拡張子指定(例:”mdb”,”accdb”)
Sub GetSubDir_ACC(Path As String, Optional extA As String = “mdb”)
Dim buf As String, f As Object
buf = Dir(Path & “\*.” & “accdb”)
Do While buf <> “”

sFullPath = Path & “\” & buf

Cells(1, 1) = sFullPath

If Right(buf, 3) = “cdb” Then
Call ExportAll_ACC(sFullPath, buf)
End If

buf = Dir()
Loop
With CreateObject(“Scripting.FileSystemObject”)
For Each f In .GetFolder(Path).SubFolders
Call GetSubDir_ACC(f.Path, extA)
DoEvents
Next f
End With
End Sub

‘@機能    :VBAに含まれるモジュールをファイル出力
‘@メモ    :出力ファイルフォーマット プリセット_モジュール名_ファイル名_.bas
‘@拡張子   :mdb,accdb
‘@出力拡張子 :*.cls,*.frm,*.bas
Sub ExportAll_ACC(ByVal sFPath As String, ByVal sName As String)
On Error GoTo myError
Dim module As VBComponent ‘// モジュール
Dim moduleList As VBComponents ‘// VBAプロジェクトの全モジュール
Dim extension ‘// モジュールの拡張子
Dim sPath ‘// 処理対象ブックのパス
Dim sFilePath ‘// エクスポートファイルパス
Dim TargetBook ‘// 処理対象ブックオブジェクト

Dim bkCurrent As Workbook

Set accessObj = CreateObject(“Access.Application”)
accessObj.OpenCurrentDatabase (sFPath)

sPath = Replace(sFPath, sName, “”)
‘ モジュールをテキスト化
Set VBProject = accessObj.VBE.ActiveVBProject

For Each vbcComp In VBProject.VBComponents
Select Case vbcComp.Type
Case vbext_ct_Document, vbext_ct_StdModule
ext = “.bas”
Case vbext_ct_ClassModule
ext = “.cls”
Case vbext_ct_MSForm
ext = “.frm”
Case Else
ext = “”
End Select

‘ Accessでは、「/」 入りのモジュール名を作成することができるが
‘ モジュールファイルをエクスポートするとOSの問題で、
‘ 「/」入りのファイル名を保存することができない
‘ そのため、「/」文字を「_」に変換してエクスポートする
moduleName = Replace(vbcComp.Name, “/”, “_”)
‘// エクスポート実施
sFilePath = sPath & “\” & moduleName & “_” & Replace(sName, “.”, “”) & “_” & ext
vbcComp.Export (sFilePath)
Next

‘ mdbを閉じる
accessObj.Quit
myError:
End Sub

https://matome.naver.jp/odai/2153994208760917001
2018年10月19日