この記事では、フォルダにある全AccessデータベースファイルのVBAのソースコードを全てExcelのシートに出力する方法についてご説明します。
【動画】フォルダにある全AccessデータベースファイルのVBAのソースコードを全てExcelのシートに出力する実際の動き
本題に入る前に、まずは次の動画をご覧ください。
フォルダ内にあるAccessのデータベースファイル名を取得し、データベースを開いてモジュール情報を取得します。
モジュール情報からモジュールにあるソースコードを取得しています。
取得したソースコードはモジュールごとに生成したExcelファイルのシートに出力しています。
生成したシートがすぐに参照できるよう、シート「top」に目次を作成しています。
マクロ作成の流れ
Accessのデータベースファイルは拡張子が「mdb」と「accdb」のファイルです。
なおシートに付ける名前には、Accessのデータベースファイル名と、コンポーネントの中にあるモジュール名を使います。
ExcelファイルとAccessのデータベースファイルの例
今回は次のExcelファイルを用意しました。
また、今回は以下のフォルダ配下にAccessのデータベースファイルを用意しました。
以上のフォルダに入っているAccessのデータベースファイルは次の通りです。
- 0272_1.accdb
- 0272_2.mdb
- 0272_3.mdb
- 0272_4.accdb
- 0272_5.mdb
Accessのデータベースファイル以外にもテキストファイルやワードのファイルもありますがこれらはテスト用のダミーファイルです。(Accessのデータベースファイルだけを取得できるか確認するため)
AccessのデータベースファイルのVBAのコードは次の通りです。
マクロを実行すると、モジュール別にシートが生成されてソースが出力されます。
シート名はAccessのデータベースファイル名とモジュール名を使用しています。
また、シート「top」に目次を用意し、生成されたシートへのリンクを生成しています。
リンクをクリックすると、該当のモジュールのソースコードが出力されたシートに移動することができます。
コードの例
Option Explicit
Private Sub btn_exec_Click()
Dim fso As FileSystemObject 'FileSystemObjectのインスタンス用変数
Dim rowCnt As Long '行数を数えるカウンタ
Dim thisWb As Workbook '本マクロ用のワークブック用変数
Dim topSheet As Worksheet 'topのシート用変数
Dim FolderPath As String 'フォルダのパス
Dim ws As Worksheet 'ワークシート用変数
Dim dbFPathAry() As String 'Accessのデータベースファイルのフルパスを格納する配列
Dim dbFPathAryCnt As Long '配列dbFPathAryの要素数カウント用カウンタ
Dim db As Object 'Accessアプリケーションインスタンス用変数
Dim cnt As Long 'カウンタ
Dim vbcmp As Object 'VBProjectのVBComponentsコレクション用変数
Dim addSheetNM As String '追加するシート名
Dim linesCnt As Long 'ソースコードの行数用カウンタ
Dim sheetCnt As Long 'シート用カウンタ
'FileSystemObjectのインスタンスを生成する
Set fso = New FileSystemObject
'データを出力する行位置
Const bgnRowPos As Long = 5
'データを出力する行位置を取得する
rowCnt = bgnRowPos
'シート用カウンタを初期化する
sheetCnt = 1
'本マクロのブックを取得する
Set thisWb = ActiveWorkbook
'本マクロのブックのシート名を取得する
Set topSheet = thisWb.Worksheets("top")
'モジュールに関する各情報を出力するセルをクリアする
topSheet.Range("A" & bgnRowPos & ":D1000").ClearContents
If Right(topSheet.Range("dirPath").Value, 1) = "¥" Then
'入力された「Excelファイルの置き場」のフルパスの末尾に「¥」が付いている場合
'「Excelファイルの置き場」のフルパスを変数FolderPathに格納する
FolderPath = topSheet.Range("dirPath").Value
Else
'入力された「Excelファイルの置き場」のフルパスの末尾に「¥」が付いていない場合
'「Excelファイルの置き場」のフルパスの末尾に「¥」を付けて、フルパスを変数FolderPathに格納する
FolderPath = topSheet.Range("dirPath").Value & "¥"
End If
'ワークブックのすべてのシートをループ
For Each ws In thisWb.Worksheets
If ws.Name <> "top" Then
'シートの名前が「top」と異なる場合
'メッセージを表示させないよう設定
Application.DisplayAlerts = False
'シートを削除する
ws.Delete
'メッセージを表示させない設定を解除
Application.DisplayAlerts = True
End If
Next ws
'フォルダとファイルを検索するサブルーチンを呼び出す
Call fileSearch(FolderPath, dbFPathAry(), dbFPathAryCnt)
'Accessアプリケーション用インスタンスを生成する
Set db = CreateObject("Access.Application")
For cnt = 0 To UBound(dbFPathAry)
'Accessのデータベースファイルを開く
db.OpenCurrentDatabase dbFPathAry(cnt)
'プロジェクト内のコンポーネントの数分ループ
For Each vbcmp In db.VBE.ActiveVBProject.VBComponents
With vbcmp.CodeModule
'取得したソースコードを出力する新たなシートの名前を取得する
addSheetNM = sheetCnt & "_" & fso.GetBaseName(dbFPathAry(cnt)) & "_" & vbcmp.Name
'新しいシートを作成する
thisWb.Sheets.Add(After:=Sheets(Sheets.Count)).Name = addSheetNM
'D列に追加したシート名のセルから、新たに追加したシートに遷移できるリンクを設置する
topSheet.Hyperlinks.Add _
Anchor:=topSheet.Range("D" & rowCnt), _
Address:="", _
SubAddress:=addSheetNM & "!A1", _
TextToDisplay:=addSheetNM
'A列のセルに項番を出力する
topSheet.Range("A" & rowCnt).Value = (rowCnt - bgnRowPos) + 1
'B列のセルにAccessのデータベースファイルの格納先を出力する
topSheet.Range("B" & rowCnt).Value = fso.GetFile(dbFPathAry(cnt)).ParentFolder.Path
'C列のセルにAccessのデータベースファイル名を出力する
topSheet.Range("C" & rowCnt).Value = fso.GetFileName(dbFPathAry(cnt))
'新たに追加したシートのA1のセルに、「top」のシートに遷移できるリンクを設置する
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="top!A1", TextToDisplay:="→topのシートに戻る"
'ソースコードの行数分ループ
For linesCnt = 1 To .CountOfLines
'セルにソースコードを出力する
Worksheets(addSheetNM).Range("A" & linesCnt + 1).Value = .Lines(linesCnt, 1)
Next linesCnt
End With
rowCnt = rowCnt + 1
sheetCnt = sheetCnt + 1
Next vbcmp
'開いているAccessのデータベースファイルを閉じる
db.CloseCurrentDatabase
Next cnt
'シート「top」を選択する
topSheet.Select
End Sub
Sub fileSearch(FolderPath As String, dbFPathAry() As String, dbFPathAryCnt As Long)
Dim fso As Object 'FileSystemObjectのインスタンス用変数
Dim Folder As Object 'フォルダ用変数
Dim FileItem As Object '取得したファイル用変数
Dim SubFolder As Object 'サブフォルダ用変数
'FileSystemObjectのインスタンスを生成する
Set fso = CreateObject("Scripting.FileSystemObject")
'GetFolderメソッドを使用して、指定したパスのフォルダを取得する
Set Folder = fso.GetFolder(FolderPath)
'フォルダ内にあるファイルの数分処理を繰り返す
For Each FileItem In Folder.Files
Select Case fso.GetExtensionName(FileItem.Path)
Case "mdb", "accdb"
'ファイル名の拡張子に「mdb」または「accdb」が含まれる場合
'⇒(Accessのデータベースファイルの場合)
'配列dbFPathAryを再定義する
ReDim Preserve dbFPathAry(dbFPathAryCnt)
'(Accessのデータベース)ファイルのフルパスを取得して配列dbFPathAryに格納する
dbFPathAry(dbFPathAryCnt) = FileItem.Path
dbFPathAryCnt = dbFPathAryCnt + 1
End Select
DoEvents
Next FileItem
'パスのサブフォルダを対象にループする
For Each SubFolder In Folder.SubFolders
'本サブルーチンを再帰呼び出しする
Call fileSearch(SubFolder.Path, dbFPathAry(), dbFPathAryCnt)
Next SubFolder
End Sub
注目すべきコード①
最初に見て頂きたいのは41行目から55行目です。
If Right(topSheet.Range("dirPath").Value, 1) = "¥" Then
'入力された「Excelファイルの置き場」のフルパスの末尾に「¥」が付いている場合
'「Excelファイルの置き場」のフルパスを変数FolderPathに格納する
FolderPath = topSheet.Range("dirPath").Value
Else
'入力された「Excelファイルの置き場」のフルパスの末尾に「¥」が付いていない場合
'「Excelファイルの置き場」のフルパスの末尾に「\」を付けて、フルパスを変数FolderPathに格納する
FolderPath = topSheet.Range("dirPath").Value & "¥"
End If
コードの説明
以上のコードは、Accessのデータベースファイルを検索するトップフォルダを取得するコードです。
トップフォルダのパスは、B2のセル(dirPathという名前付きセル)に入力されたパスから取得しています。
※B2の黄色のセルには「dirPath」という名前を付けています。B2セルにフォルダのパスを指定することで、そのフォルダ以下を再帰的に検索することができます。
コードの詳細
41行目のコードは、B2セルに入力されたパスの末尾に「¥」の文字が含まれているか判定するIFです。
もし「¥」の文字が含まれている場合は、46行目で変数FolderPathにそのままパスを格納します。
「¥」の文字が含まれていない場合は、53行目でパスの末尾に「¥」を付けて変数FolderPathに格納します。
注目すべきコード②
次に見て頂きたいのは58行目から75行目です。
'ワークブックのすべてのシートをループ
For Each ws In thisWb.Worksheets
If ws.Name <> "top" Then
'シートの名前が「top」と異なる場合
'メッセージを表示させないよう設定
Application.DisplayAlerts = False
'シートを削除する
ws.Delete
'メッセージを表示させない設定を解除
Application.DisplayAlerts = True
End If
Next ws
コードの説明
以上のコードは、「top」以外のシートが存在している場合はすべて削除する処理のコードです。
コードの詳細
58行目のコードは、Excelファイルにあるシートの数だけ処理を繰り返すFor文です。
60行目のコードは、シートが「top」かどうかを判定するIFで、「top」以外のシートの場合は68行目でそのシートを削除します。(「top」以外のシートは不要のため)
なお、68行目にあるDeleteを実行すると、以下のメッセージが出力されます。
シートを削除してよいか確認するメッセージですが、このメッセージボックスが表示されてしまうとマクロの処理が中断してしまいます。
なので、このメッセージボックスが表示されないようにする必要があります。
メッセージボックスが表示されないようにするには、65行目のコードのDisplayAlertsプロパティにFalseを設定します。
68行目のDeleteメソッドが実行されたら、71行目でDisplayAlertsプロパティにTrueを設定します。
注目すべきコード③
次に見て頂きたいのは78行目です。
'フォルダとファイルを検索するサブルーチンを呼び出す
Call fileSearch(FolderPath, dbFPathAry(), dbFPathAryCnt)
コードの説明
以上のコードは、サブフォルダ含めて全てのフォルダ内のファイルを検索するサブルーチン「fileSearch」を呼び出す処理です。
「fileSearch」には以下の引数を渡して呼び出します。
- FolderPath：ファイル名の検索先フォルダ
- dbFPathAry()：Accessのデータベースファイル名のフルパスを格納する配列
- dbFPathAryCnt：配列dbFPathAryの要素数用のカウンタ変数
FolderPath
FolderPathにはファイル名の検索先フォルダを指定します。
FolderPathで指定されたフォルダを「fileSearch」に渡し、「fileSearch」内でファイルが存在するか検索します。
dbFPathAry()
dbFPathAryは、サブルーチン「fileSearch」内で取得するAccessのデータベースファイルのフルパスを格納する配列です。
dbFPathAryCnt
dbFPathAryCntは、配列dbFPathAryの要素数用のカウンタ変数です。
注目すべきコード④
次に見て頂きたいのは151行目から154行目です。
'FileSystemObjectのインスタンスを生成する
Set fso = CreateObject("Scripting.FileSystemObject")
'GetFolderメソッドを使用して、指定したパスのフォルダを取得する
Set Folder = fso.GetFolder(FolderPath)
コードの説明
以上のコードは、FileSystemObjectのインスタンスを生成し、フォルダとファイルを検索したいフォルダのトップ階層のパスのフォルダを取得する処理のコードです。
FileSystemObjectのインスタンスのGetFolderメソッドに、フォルダとファイルを検索したいフォルダのトップ階層のパスを指定して実行することで、パス内のフォルダ名やファイル名を取得できます。
注目すべきコード⑤
次に見て頂きたいのは157行目から178行目です。
'フォルダ内にあるファイルの数分処理を繰り返す
For Each FileItem In Folder.Files
Select Case fso.GetExtensionName(FileItem.Path)
Case "mdb", "accdb"
'ファイル名の拡張子に「mdb」または「accdb」が含まれる場合
'⇒(Accessのデータベースファイルの場合)
'配列dbFPathAryを再定義する
ReDim Preserve dbFPathAry(dbFPathAryCnt)
'(Accessのデータベース)ファイルのフルパスを取得して配列dbFPathAryに格納する
dbFPathAry(dbFPathAryCnt) = FileItem.Path
dbFPathAryCnt = dbFPathAryCnt + 1
End Select
DoEvents
Next FileItem
コードの説明
以上のコードは、フォルダ内にあるファイルがAccessのデータベースファイルかどうかを判定し、Accessのデータベースファイルの場合はそのファイルのフルパスを配列dbFPathAryに格納する処理のコードです。
フォルダ内にあるファイルがAccessのデータベースファイルかどうかはGetExtensionNameを使い、ファイルの拡張子に「mdb」または「accdb」が含まれるかどうかで判定しています。
コードの詳細
157行目のコードは、フォルダ内にあるファイルの数分処理を繰り返すFor文で、もしファイルの拡張子が「mdb」または「accdb」かどうかを161行目で判定します。
ファイルの拡張子が「mdb」または「accdb」の場合は167行目で配列dbFPathAryを再定義し、170行目でAccessのデータベースファイルのフルパスを取得して配列dbFPathAryに格納します。
注目すべきコード⑥
次に見て頂きたいのは181行目から186行目です。
'パスのサブフォルダを対象にループする
For Each SubFolder In Folder.SubFolders
'本サブルーチンを再帰呼び出しする
Call fileSearch(SubFolder.path, dbFPathAry(), dbFPathAryCnt)
Next SubFolder
コードの説明
以上のコードは、サブフォルダが存在する間は自分自身のサブルーチンを繰り返し呼び出す再帰処理を行っているコードです。
再帰処理とは、サブルーチンの処理が行われている途中で、強制的に自分自身のサブルーチンを呼び出して再度サブルーチンの最初から処理を行わせることを言います。
強制的に自分自身のサブルーチンを呼び出しているのは184行目です。
184行目でfileSearchが呼び出されると、fileSearchの処理の途中で143行目(fileSearchの最初)から強制的に開始されます。
この再帰処理(fileSearch処理中の再呼び出し)は、181行目のFor文内で繰り返し行われますが、このFor文が終わらないかぎりfileSearchが再度呼び出されます。
なお、For文から抜ける条件は、すべてのサブフォルダの参照が終わることです。(引数にサブフォルダを指定してfileSearchを呼び出す)
すべてのサブフォルダを参照すればFor文を抜けます。
For文から抜ければfileSearchが呼び出されることがなくなるので(再帰処理が行われない)、fileSearchのEnd Subまで処理が進みfileSearchの処理を抜けて、fileSearchの呼び出し元の78行目に遷移します。
そのまま78行目の次の行に処理が遷移します。
注目すべきコード⑦
次に見て頂きたいのは81行目です。
'Accessアプリケーション用インスタンスを生成する
Set db = CreateObject("Access.Application")
コードの説明
以上のコードは、Accessデータベースファイル用インスタンスを生成するコードです。
ExcelのマクロがAccessのデータベースファイルを開くのにこのインスタンスを使用します。(閉じる時も使います)
注目すべきコード⑧
次に見て頂きたいのは83行目から86行目です。
For cnt = 0 To UBound(dbFPathAry)
'Accessのデータベースファイルを開く
db.OpenCurrentDatabase dbFPathAry(cnt)
コードの説明
以上のコードは、Accessのデータベースファイル名の数だけAccessのデータベースファイルを開く処理のコードです。
OpenCurrentDatabaseメソッドにAccessのデータベースファイルを指定して実行すると、Accessのデータベースファイルが開きます。
AccessのデータベースファイルにあるVBAのコードやモジュール名など取得するのに、Accessのデータベースファイルを開く必要があるので、OpenCurrentDatabaseを実行してファイルを開きます。
注目すべきコード⑨
次に見て頂きたいのは91行目から126行目です。
With vbcmp.CodeModule
'取得したソースコードを出力する新たなシートの名前を取得する
addSheetNM = sheetCnt & "_" & fso.GetBaseName(dbFPathAry(cnt)) & "_" & vbcmp.Name
'新しいシートを作成する
thisWb.Sheets.Add(After:=Sheets(Sheets.Count)).Name = addSheetNM
'D列に追加したシート名のセルから、新たに追加したシートに遷移できるリンクを設置する
topSheet.Hyperlinks.Add _
Anchor:=topSheet.Range("D" & rowCnt), _
Address:="", _
SubAddress:=addSheetNM & "!A1", _
TextToDisplay:=addSheetNM
'A列のセルに項番を出力する
topSheet.Range("A" & rowCnt).Value = (rowCnt - bgnRowPos) + 1
'B列のセルにAccessのデータベースファイルの格納先を出力する
topSheet.Range("B" & rowCnt).Value = fso.GetFile(dbFPathAry(cnt)).ParentFolder.Path
'C列のセルにAccessのデータベースファイル名を出力する
topSheet.Range("C" & rowCnt).Value = fso.GetFileName(dbFPathAry(cnt))
'新たに追加したシートのA1のセルに、「top」のシートに遷移できるリンクを設置する
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="top!A1", TextToDisplay:="→topのシートに戻る"
'ソースコードの行数分ループ
For linesCnt = 1 To .CountOfLines
'セルにソースコードを出力する
Worksheets(addSheetNM).Range("A" & linesCnt + 1).Value = .Lines(linesCnt, 1)
Next linesCnt
End With
コードの説明
以上のコードは、開いているAccessのデータベースファイルからモジュール情報を取得し、そのモジュール情報の中からモジュール名やモジュールのソースコードを取得してExcelのシートに出力する処理のコードです。
また、目次も作成しています。
コードの詳細
89行目のコードは、プロジェクト内のコンポーネントの数分ループするFor文です。
94行目のコードは、ソースコードを出力するシートの名前を生成し、その名前を使ってシートを作成します。(97行目)
100行目から104行目のコードでは、「シート名」(D列)の値にハイパーリンクを設置し、クリックするとそのシートに移動できるようにします。
リンク先で表示された時のセルの選択位置はA1としてあります。
107行目のコードでは、A列のセルに項番を出力します。
110行目のコードでは、B列のセルにAccessのデータベースファイルの格納先を出力します。
113行目のコードでは、C列のセルにAccessのデータベースファイル名を出力します。
116行目のコードでは、新たに追加したシートのA1のセルに、「top」のシートに遷移できるリンクを設置します。
119行目のコードは、モジュールのソースコードの行数分処理を繰り返すFor文です。
122行目のコードでは、セルにソースコードを出力します。
注目すべきコード⑩
次に見て頂きたいのは135行目です。
'開いているAccessのデータベースファイルを閉じる
db.CloseCurrentDatabase
コードの説明
以上のコードは、開いているAccessのデータベースファイルを閉じる処理のコードです。
開いているAccessのデータベースファイルを閉じないと、次にAccessのデータベースファイルを開いたときにエラーとなり、下のメッセージが表示されてしまいます。
動作確認
「ExcelファイルとAccessのデータベースファイルの例」をご覧ください。
【注意】参照設定が必要です
一つ注意点があるのですが、先ほどのコードを動かすには参照設定が必要です。
参照設定の一覧(下の画像を参考)から次の項目(ライブラリ)にチェックを付けて「OK」ボタンをクリックします。
- Windows Script Host Object Model(wshom.ocx)
なぜ必要かというと、Excelのマクロのコードの5行目の「FileSystemObject」というオブジェクトが「wshom.ocx」というファイルを参照するからです。
Dim fso As FileSystemObject 'FileSystemObjectのインスタンス用変数
この参照設定をしないと下の画像のエラーが出ますので必ず行う必要があります。
ここでは「wshom.ocx」とは何者かについては記事の本題から逸れてしまうので詳細は割愛しますが、マクロで「FileSystemObject」というオブジェクトを使う場合は参照設定しないと動かない、程度に思って頂ければと思います。
最後に
この記事では、フォルダにある全AccessデータベースファイルのVBAのソースコードを全てExcelのシートに出力する方法についてご説明しました。
フォルダにある全AccessデータベースファイルのVBAのソースコードを確認したい時には本記事を参考にしてみてくださいね。
プログラミングのスキルを習得するなら
プログラミングのスキルを習得したい、今のスキルをもっと高めたい、そう考えているなら「プログラミングスクール」がおすすめです。
プログラミングのスキルの基礎を身につけるなら「TechAcademy」で1週間の無料体験があるので、これで「プログラミングの基礎」を学ぶのにおすすめですよ。
