頑張らないために頑張る

ゆるく頑張ります

AccessMDBの調査が苦行なので分析用コードを作った

Posted at — Jun 4, 2025

背景と目的

pic

Accessデータベースは、その手軽さから広く利用されていますが、長期運用や複数人による改修、ドキュメントの不備などにより、内部構造が複雑化し、現状把握が困難になることがあります。よくあります。このような状況は、メンテナンス性の低下やシステム移行時のリスク増大に繋がります。このVBAソースコードは、そんなMicrosoft Accessデータベース（.mdbまたは.accdbファイル）の包括的な分析を行い、その結果をMarkdown形式のレポートとして出力します。

具体的には、データベースの構造を詳細に把握し、将来的なシステム移行や改修を検討する際に重要となる機能的な側面を特定するための情報を、Markdown形式で出力します。利用方法も簡単で、このソースコードを分析したいMDB内にコピぺして実行するだけで良いので、あとは実行結果が出力されるまで待って分析作業に着手するだけです。

このコードは、これらの課題に対応するため、以下のニーズに応えることを目指しています。

なお、実行時間はAccessプロジェクト内オブジェクトの数やサイズに依存します。そのため、大規模なものほど処理に時間がかかりますので、処理中はコーヒーブレイクでも取ることをお勧めします(/・ω・)/

実行環境

今回のソースコードは、以下の環境で動作を確認しています。

alt text

ソースコード

Option Compare Database
Option Explicit

' 統合MDB分析ツール
' データベース構造の包括的な把握と、新システム移行のための機能分析を支援

Sub GenerateMdbAnalysisReportMarkdown()
    ' メインプロシージャ: レポート生成の起点
    
    ' レポート出力先を設定
    Dim strFilePath As String
    strFilePath = CurrentProject.Path & "\MigrationAnalysisReport.md"
    
    ' ファイルをオープン
    Dim intFileNum As Integer
    intFileNum = FreeFile
    Open strFilePath For Output As #intFileNum
    
    ' レポートヘッダー (Markdown形式)
    Print #intFileNum, "# MDB総合分析レポート (構造把握 & 移行検討)"
    Print #intFileNum, ""
    Print #intFileNum, "**データベース:**`" & CurrentProject.Name & "`"
    Print #intFileNum, "**分析日時:** " & Now()
    Print #intFileNum, ""
    Print #intFileNum, "---" ' 水平線
    Print #intFileNum, ""
    
    ' 各分析プロシージャを呼び出し
    IntegratedAnalyzeStartupSettingsMD intFileNum
    IntegratedAnalyzeTablesMD intFileNum
    IntegratedAnalyzeQueriesMD intFileNum
    IntegratedAnalyzeFormsMD intFileNum
    IntegratedAnalyzeReportsMD intFileNum
    IntegratedAnalyzeModulesMD intFileNum
    IntegratedAnalyzeMacrosMD intFileNum
    IntegratedAnalyzeExternalConnectionsMD intFileNum
    IntegratedAnalyzeSecurityModelMD intFileNum
    IntegratedAnalyzeDependenciesMD intFileNum
    
    ' ファイルをクローズ
    Close #intFileNum
    
    ' 完了メッセージ
    MsgBox "MDB総合分析レポート (Markdown形式) が完了しました。レポートは次の場所に保存されました：" & vbCrLf & strFilePath, _
           vbInformation, "分析完了"
End Sub

' --- 1. スタートアップ設定分析 (Markdown) ---
Sub IntegratedAnalyzeStartupSettingsMD(ByVal FileNum As Integer)
    Print #FileNum, "## 1. スタートアップ設定"
    Print #FileNum, ""
    Print #FileNum, "- **スタートアップフォーム:** " & MDEscape(GetStartupForm())
    Print #FileNum, "- **起動時の表示:** " & MDEscape(GetDisplayForm())
    Print #FileNum, "- **ナビゲーションウィンドウの表示:** " & MDEscape(GetNavPaneDisplay())
    Print #FileNum, ""
    Print #FileNum, "---"
    Print #FileNum, ""
End Sub

' --- 2. テーブル分析 (構造、重要度、リレーションシップ) (Markdown) ---
Sub IntegratedAnalyzeTablesMD(ByVal FileNum As Integer)
    Dim db As DAO.Database
    Dim tdf As DAO.TableDef
    Dim fld As DAO.Field
    Dim idx As DAO.Index
    Dim rel As DAO.Relation
    Dim qdf As DAO.QueryDef
    Dim i As Integer, usageCount As Integer
    Dim obj As AccessObject
    Dim usageObjects As Collection
    
    Set db = CurrentDb
    
    Print #FileNum, "## 2. テーブル分析"
    Print #FileNum, ""
    
    Dim userTableCount As Long
    userTableCount = 0
    
    For Each tdf In db.TableDefs
        Set usageObjects = New Collection
        
        If Left(tdf.Name, 4) <> "MSys" And Left(tdf.Name, 1) <> "~" Then
            userTableCount = userTableCount + 1
            usageCount = 0
            
            ' クエリでの使用状況をカウント
            For Each qdf In db.QueryDefs
                If InStr(1, qdf.SQL, "[" & tdf.Name & "]", vbTextCompare) > 0 Or _
                   InStr(1, qdf.SQL, " " & tdf.Name & " ", vbTextCompare) > 0 Or _
                   (InStr(1, qdf.SQL, tdf.Name, vbTextCompare) > 0 And (Right(qdf.SQL, Len(tdf.Name)) = tdf.Name Or Left(qdf.SQL, Len(tdf.Name)) = tdf.Name)) Then
                   usageObjects.Add (qdf.Name)
                    usageCount = usageCount + 1
                End If
            Next qdf
            
            ' フォームでの使用状況をカウント
            For Each obj In CurrentProject.AllForms
                Dim isCountedInForm As Boolean ' フォーム内でカウント済みかどうかのフラグ
                isCountedInForm = False
                
                On Error Resume Next
                Dim tempForm As Form
                DoCmd.OpenForm obj.Name, acDesign, , , , acHidden
                If Err.Number = 0 Then
                    Set tempForm = Forms(obj.Name)
                    ' フォームのレコードソースでの使用状況をチェック
                    If InStr(1, tempForm.RecordSource, tdf.Name, vbTextCompare) > 0 Then
                        usageObjects.Add (obj.Name)
                        usageCount = usageCount + 1
                        isCountedInForm = True ' レコードソースで使われているのでカウント済み
                    End If
                    
                    ' Rem 変更/追加箇所: フォームのVBAコード内での使用状況チェックを追加
                    If Not isCountedInForm And tempForm.hasModule Then
                        Dim codeMod As Object ' VBIDE.CodeModule
                        Dim lineNum As Long
                        Set codeMod = Application.VBE.ActiveVBProject.VBComponents.Item("Form_" + obj.Name).CodeModule
                        If Not (codeMod Is Nothing) Then
                            For lineNum = 1 To codeMod.CountOfLines
                                ' SQL文やレコードセット操作でテーブル名が使われているかを簡易的にチェック
                                If InStr(1, codeMod.Lines(lineNum, 1), """" & tdf.Name & """", vbTextCompare) > 0 Or _
                                   InStr(1, codeMod.Lines(lineNum, 1), " " & tdf.Name & " ", vbTextCompare) > 0 Then
                                    ' 例: "SELECT * FROM Products", CurrentDb.OpenRecordset("Products")
                                    ' 注: このチェックは完全ではありませんが、多くのケースをカバーします。
                                    usageObjects.Add (obj.Name)
                                    usageCount = usageCount + 1
                                    isCountedInForm = True ' VBAコード内で見つかったのでカウント済み
                                    Exit For ' このフォームでは1回だけカウントするためループを抜ける
                                End If
                            Next lineNum
                        
                        End If
                        Set codeMod = Nothing
                    End If
                    ' Rem 変更/追加箇所ここまで
                    
                    DoCmd.Close acForm, obj.Name, acSaveNo
                    Set tempForm = Nothing
                Else
                    Err.Clear
                End If
                On Error GoTo 0
            Next obj
            
            ' レポートのレコードソースでの使用状況をカウント
            For Each obj In CurrentProject.AllReports
                On Error Resume Next
                Dim tempReport As Report
                DoCmd.OpenReport obj.Name, acViewDesign, , , acHidden
                If Err.Number = 0 Then
                    Set tempReport = Reports(obj.Name)
                    If InStr(1, tempReport.RecordSource, tdf.Name, vbTextCompare) > 0 Then
                        usageObjects.Add (obj.Name)
                        usageCount = usageCount + 1
                    End If
                    DoCmd.Close acReport, obj.Name, acSaveNo
                    Set tempReport = Nothing
                Else
                    Err.Clear
                End If
                On Error GoTo 0
            Next obj

            Print #FileNum, "### テーブル: `" & MDEscape(tdf.Name) & "`"
            Print #FileNum, ""
            Print #FileNum, "- **フィールド数:** " & tdf.Fields.count
            If Len(tdf.Connect) > 0 Then
                Print #FileNum, "- **種類:** リンクテーブル (移行時に接続先とデータ取得方法の再検討が必要)"
                Print #FileNum, "  - **接続先:** `" & MDEscape(tdf.Connect) & "`"
                Print #FileNum, "  - **ソーステーブル:** `" & MDEscape(tdf.SourceTableName) & "`"
            Else
                Print #FileNum, "- **種類:** ローカルテーブル"
            End If
            Print #FileNum, "- **推定重要度 (簡易):** " & IIf(usageCount > 3, "**高**", IIf(usageCount > 1, "中", "低"))
            Print #FileNum, "- **使用参照数 (クエリ/フォーム/レポート):** " & usageCount
            If usageCount > 0 Then
                Dim usageObjectsName As String
                usageObjectsName = ""
                
                Dim usageObject
                For Each usageObject In usageObjects
                    usageObjectsName = usageObjectsName + usageObject + ", "
                Next usageObject
            
                Print #FileNum, "- **使用参照元:** " & usageObjectsName
            End If
            
            
            If tdf.Indexes.count > 0 Then
                Print #FileNum, "- **インデックス (" & tdf.Indexes.count & "個):**"
                Dim pkFields As String: pkFields = ""
                For Each idx In tdf.Indexes
                    Dim strIdxFields As String: strIdxFields = ""
                    If idx.Fields.count > 0 Then
                        For i = 0 To idx.Fields.count - 1
                            strIdxFields = strIdxFields & "`" & MDEscape(idx.Fields(i).Name) & "`, "
                        Next i
                        strIdxFields = Left(strIdxFields, Len(strIdxFields) - 2)
                    Else
                        strIdxFields = "(フィールドなし)"
                    End If

                    If idx.Primary Then
                        Print #FileNum, "  - **`" & MDEscape(idx.Name) & "`** (主キー: " & strIdxFields & ")"
                        pkFields = strIdxFields
                    Else
                        Print #FileNum, "  - `" & MDEscape(idx.Name) & "` (" & IIf(idx.Unique, "Unique, ", "") & "Fields: " & strIdxFields & ")"
                    End If
                Next idx
                If pkFields = "" Then Print #FileNum, "  - (主キー未設定)"
            Else
                Print #FileNum, "- **インデックス:** (なし)"
                Print #FileNum, "  - (主キー未設定)"
            End If
            Print #FileNum, ""
        End If
    Next tdf
    If userTableCount = 0 Then Print #FileNum, "*ユーザー定義テーブルはありません。*" & vbCrLf
    
    Print #FileNum, "### 主要なリレーションシップ"
    Print #FileNum, ""
    If db.Relations.count > 0 Then
        For Each rel In db.Relations
            Print #FileNum, "- **関連名:** `" & MDEscape(rel.Name) & "`"
            Print #FileNum, "  - **親テーブル (主キー側):** `" & MDEscape(rel.Table) & "`"
            Print #FileNum, "  - **子テーブル (外部キー側):** `" & MDEscape(rel.ForeignTable) & "`"
            Dim strAttributes As String: strAttributes = ""
            If (rel.Attributes And dbRelationUpdateCascade) Then strAttributes = strAttributes & "更新カスケード "
            If (rel.Attributes And dbRelationDeleteCascade) Then strAttributes = strAttributes & "削除カスケード "
            If (rel.Attributes And dbRelationDontEnforce) Then strAttributes = strAttributes & "整合性強制なし "
            If Trim(strAttributes) = "" Then strAttributes = "参照整合性あり (カスケードなし、または制限)"
            Print #FileNum, "  - **属性:** " & MDEscape(Trim(strAttributes))
            Print #FileNum, ""
        Next rel
    Else
        Print #FileNum, "*リレーションシップは設定されていません。*" & vbCrLf
    End If
    Print #FileNum, "---"
    Print #FileNum, ""
End Sub

' --- 3. クエリ分析 (Markdown) ---
Sub IntegratedAnalyzeQueriesMD(ByVal FileNum As Integer)
    Dim db As DAO.Database
    Dim qdf As DAO.QueryDef
    Set db = CurrentDb
    
    Print #FileNum, "## 3. クエリ分析"
    Print #FileNum, ""
    
    If db.QueryDefs.count > 0 Then
        For Each qdf In db.QueryDefs
            If Left(qdf.Name, 4) <> "~sq_" And Left(qdf.Name, 1) <> "~" Then
                Print #FileNum, "### クエリ:`" & MDEscape(qdf.Name) & "`"
                Print #FileNum, ""
                Print #FileNum, "- **種類:** " & MDEscape(GetQueryType(qdf.Type))
                
                Dim queryNotes As String: queryNotes = ""
                If qdf.Type <> dbQSelect And qdf.Type <> dbQCrosstab Then
                    queryNotes = queryNotes & "データ操作/定義クエリ (**移行時ロジック確認必須**)。"
                End If
                If InStr(1, qdf.SQL, "SUM(", vbTextCompare) > 0 Or _
                   InStr(1, qdf.SQL, "AVG(", vbTextCompare) > 0 Or _
                   InStr(1, qdf.SQL, "COUNT(", vbTextCompare) > 0 Or _
                   InStr(1, qdf.SQL, "GROUP BY", vbTextCompare) > 0 Then
                    queryNotes = queryNotes & "集計処理を含む可能性あり。"
                End If
                If qdf.Type = dbQMakeTable Then
                    queryNotes = queryNotes & "テーブル作成クエリ (作成先はSQL文中のINTO句参照)。"
                End If
                
                If queryNotes <> "" Then Print #FileNum, "- **移行時の注意:** " & MDEscape(queryNotes)
                
                If Trim(qdf.SQL) <> "" Then
                    Print #FileNum, "- **SQL:**"
                    Print #FileNum, "```sql"
                    Print #FileNum, Trim(qdf.SQL) ' SQL文をそのまま出力
                    Print #FileNum, "```"
                Else
                    Print #FileNum, "- **SQL:** (定義されていません)"
                End If
                
                If Len(qdf.Connect) > 0 Then
                    Print #FileNum, "- **外部接続:**`" & MDEscape(qdf.Connect) & "`(パススルーまたは外部DBクエリ)"
                End If
                Print #FileNum, ""
            End If
        Next qdf
    Else
        Print #FileNum, "*クエリはありません。*" & vbCrLf
    End If
    Print #FileNum, "---"
    Print #FileNum, ""
End Sub

' --- 4. フォーム分析 (Markdown) ---
Sub IntegratedAnalyzeFormsMD(ByVal FileNum As Integer)
    Dim frmObj As AccessObject
    Dim openedForm As Form
    Dim FormName As String, sourceType As String
    
    Print #FileNum, "## 4. フォーム分析"
    Print #FileNum, ""
    
    If CurrentProject.AllForms.count > 0 Then
        For Each frmObj In CurrentProject.AllForms
            FormName = frmObj.Name
            Print #FileNum, "### フォーム:`" & MDEscape(FormName) & "`"
            Print #FileNum, ""
            
            Dim blnIsCurrentlyLoaded As Boolean
            blnIsCurrentlyLoaded = IsFormLoaded(FormName)
            
            Dim strRecordSource As String: strRecordSource = "(情報取得できず)"
            Dim blnHasVbaCode As Boolean: blnHasVbaCode = False
            Dim controlsCount As Long: controlsCount = 0
            Dim commandButtonCount As Long: commandButtonCount = 0
            Dim subFormCount As Long: subFormCount = 0
            sourceType = "不明"

            On Error Resume Next
            If Not blnIsCurrentlyLoaded Then
                DoCmd.OpenForm FormName, acDesign, , , , acHidden
                If Err.Number = 0 Then Set openedForm = Forms(FormName) Else Set openedForm = Nothing
            Else
                Set openedForm = Forms(FormName)
                Print #FileNum, "  - ※現在開かれています。情報は現在の状態に基づきます。"
            End If

            If Not openedForm Is Nothing Then
                strRecordSource = openedForm.RecordSource
                blnHasVbaCode = HasCode(acForm, "Form_" + FormName)
                controlsCount = openedForm.Controls.count
                commandButtonCount = CountControls(openedForm, "CommandButton")
                subFormCount = CountControls(openedForm, "SubForm")

                If Trim(strRecordSource) <> "" Then sourceType = "データフォーム"
                ElseIf subFormCount > 0 Then sourceType = "親子フォーム/コンテナフォーム"
                ElseIf commandButtonCount > 5 Then sourceType = "メニュー/操作パネルフォーム"
                Else: sourceType = "その他/ダイアログフォーム"
                
                If Not blnIsCurrentlyLoaded And Err.Number = 0 Then DoCmd.Close acForm, FormName, acSaveNo
            End If
            Err.Clear
            On Error GoTo 0
            Set openedForm = Nothing

            Print #FileNum, "- **レコードソース:**`" & MDEscape(IIf(Trim(strRecordSource) = "", "(未設定)", strRecordSource)) & "`"
            Print #FileNum, "- **VBAコード:** " & IIf(blnHasVbaCode, "**あり** (移行時にロジック確認が必要)", "なし")
            Print #FileNum, "- **推定種類:** " & MDEscape(sourceType)
            Print #FileNum, "- **コントロール数:** " & controlsCount
            Print #FileNum, "- **コマンドボタン数:** " & commandButtonCount
            Print #FileNum, "- **サブフォーム数:** " & subFormCount
            
            Dim complexityScore As Integer
            complexityScore = controlsCount + IIf(blnHasVbaCode, 10, 0) + subFormCount * 5
            Print #FileNum, "- **複雑度評価 (簡易):** " & IIf(complexityScore > 30, "**高**", IIf(complexityScore > 15, "中", "低"))
            Print #FileNum, ""
        Next frmObj
    Else
        Print #FileNum, "*フォームはありません。*" & vbCrLf
    End If
    Print #FileNum, "---"
    Print #FileNum, ""
End Sub

' --- 5. レポート分析 (Markdown) ---
Sub IntegratedAnalyzeReportsMD(ByVal FileNum As Integer)
    Dim rptObj As AccessObject
    Dim openedReport As Report
    Dim ReportName As String
    
    Print #FileNum, "## 5. レポート分析"
    Print #FileNum, ""

    If CurrentProject.AllReports.count > 0 Then
        For Each rptObj In CurrentProject.AllReports
            ReportName = rptObj.Name
            Print #FileNum, "### レポート:`" & MDEscape(ReportName) & "`"
            Print #FileNum, ""

            Dim blnIsCurrentlyLoaded As Boolean
            blnIsCurrentlyLoaded = IsReportLoaded(ReportName)

            Dim strRecordSource As String: strRecordSource = "(情報取得できず)"
            Dim blnHasVbaCode As Boolean: blnHasVbaCode = False
            Dim groupLevelCountVal As Long: groupLevelCountVal = 0
            Dim hasModule As Boolean: hasModule = False

            On Error Resume Next
            If Not blnIsCurrentlyLoaded Then
                DoCmd.OpenReport ReportName, acViewDesign, , , acHidden
                If Err.Number = 0 Then Set openedReport = Reports(ReportName) Else Set openedReport = Nothing
            Else
                Set openedReport = Reports(ReportName)
                Print #FileNum, "  - ※現在開かれています。情報は現在の状態に基づきます。"
            End If

            If Not openedReport Is Nothing Then
                strRecordSource = openedReport.RecordSource
                blnHasVbaCode = HasCode(acReport, "Report_" + ReportName)
                groupLevelCountVal = openedReport.GroupLevelCount
                hasModule = openedReport.hasModule
                
                If Not blnIsCurrentlyLoaded And Err.Number = 0 Then DoCmd.Close acReport, ReportName, acSaveNo
            End If
            Err.Clear
            On Error GoTo 0
            Set openedReport = Nothing

            Print #FileNum, "- **レコードソース:**`" & MDEscape(IIf(Trim(strRecordSource) = "", "(未設定)", strRecordSource)) & "`"
            Print #FileNum, "- **VBAコード:** " & IIf(blnHasVbaCode, "**あり** (移行時にロジック確認が必要)", "なし")
            Print #FileNum, "- **グループ化レベル数:** " & groupLevelCountVal
            If hasModule And blnHasVbaCode Then
                 Print #FileNum, "- **注:** VBAモジュールが存在するため、複雑な書式設定や印刷ロジックが含まれる可能性があります。"
            End If
            Print #FileNum, ""
        Next rptObj
    Else
        Print #FileNum, "*レポートはありません。*" & vbCrLf
    End If
    Print #FileNum, "---"
    Print #FileNum, ""
End Sub

' --- 6. モジュール分析 (Markdown) ---
Sub IntegratedAnalyzeModulesMD(ByVal FileNum As Integer)
    Dim mdlObj As AccessObject
    
    Print #FileNum, "## 6. 標準モジュール・クラスモジュール分析"
    Print #FileNum, ""
    
    If CurrentProject.AllModules.count > 0 Then
        Dim moduleFound As Boolean
        moduleFound = False
        For Each mdlObj In CurrentProject.AllModules
            If mdlObj.Type = acModule Or mdlObj.Type = acClassModule Then
                moduleFound = True
                Print #FileNum, "### モジュール:`" & MDEscape(mdlObj.Name) & "`"
                Print #FileNum, ""
                Print #FileNum, "- **種類:** " & IIf(mdlObj.Type = acModule, "標準モジュール", "クラスモジュール")
                
                Dim roleSuggestion As String: roleSuggestion = ""
                If InStr(1, mdlObj.Name, "Util", vbTextCompare) > 0 Or InStr(1, mdlObj.Name, "Common", vbTextCompare) > 0 Then roleSuggestion = roleSuggestion & "汎用処理, "
                If InStr(1, mdlObj.Name, "Business", vbTextCompare) > 0 Or InStr(1, mdlObj.Name, "Logic", vbTextCompare) > 0 Or InStr(1, mdlObj.Name, "Process", vbTextCompare) > 0 Then roleSuggestion = roleSuggestion & "ビジネスロジック, "
                If InStr(1, mdlObj.Name, "Security", vbTextCompare) > 0 Or InStr(1, mdlObj.Name, "Auth", vbTextCompare) > 0 Or InStr(1, mdlObj.Name, "Login", vbTextCompare) > 0 Or InStr(1, mdlObj.Name, "User", vbTextCompare) > 0 Then roleSuggestion = roleSuggestion & "セキュリティ/認証関連, "
                If InStr(1, mdlObj.Name, "DB", vbTextCompare) > 0 Or InStr(1, mdlObj.Name, "Data", vbTextCompare) > 0 Then roleSuggestion = roleSuggestion & "データベース操作, "

                If roleSuggestion <> "" Then
                    roleSuggestion = Left(roleSuggestion, Len(roleSuggestion) - 2)
                    Print #FileNum, "- **推定される役割:** " & MDEscape(roleSuggestion) & " (**VBAコードの詳細分析が必要**)"
                Else
                    Print #FileNum, "- **注:** VBAコードを詳細に分析し、機能を特定してください。"
                End If
                Print #FileNum, ""
            End If
        Next mdlObj
        If Not moduleFound Then Print #FileNum, "*対象となる標準モジュールおよびクラスモジュールはありません。*" & vbCrLf
    Else
        Print #FileNum, "*標準モジュールおよびクラスモジュールはありません。*" & vbCrLf
    End If
    Print #FileNum, "---"
    Print #FileNum, ""
End Sub

' --- 7. マクロ分析 (Markdown) ---
Sub IntegratedAnalyzeMacrosMD(ByVal FileNum As Integer)
    Dim macObj As AccessObject
    
    Print #FileNum, "## 7. マクロ分析"
    Print #FileNum, ""
    
    If CurrentProject.AllMacros.count > 0 Then
        For Each macObj In CurrentProject.AllMacros
            Print #FileNum, "- **マクロ名:**`" & MDEscape(macObj.Name) & "`"
            Print #FileNum, "  - **注:** マクロの内容はAccess上で直接確認してください。複雑なロジックはVBAへの変換も検討。"
        Next macObj
        Print #FileNum, ""
    Else
        Print #FileNum, "*マクロはありません。*" & vbCrLf
    End If
    Print #FileNum, "---"
    Print #FileNum, ""
End Sub

' --- 8. 外部接続分析 (Markdown) ---
Sub IntegratedAnalyzeExternalConnectionsMD(ByVal FileNum As Integer)
    Dim db As DAO.Database
    Dim tdf As DAO.TableDef
    Dim qdf As DAO.QueryDef
    Set db = CurrentDb
    
    Print #FileNum, "## 8. 外部接続・連携分析"
    Print #FileNum, ""
    
    Print #FileNum, "### リンクテーブル・外部接続クエリの再確認"
    Print #FileNum, ""
    Dim foundExternal As Boolean: foundExternal = False
    For Each tdf In db.TableDefs
        If Len(tdf.Connect) > 0 Then
            Print #FileNum, "- **リンクテーブル:**`" & MDEscape(tdf.Name) & "`(接続先:`" & MDEscape(Left(tdf.Connect, 70)) & IIf(Len(tdf.Connect) > 70, "...", "") & "`)"
            foundExternal = True
        End If
    Next tdf
    For Each qdf In db.QueryDefs
        If Len(qdf.Connect) > 0 Then
            Print #FileNum, "- **外部接続クエリ:**`" & MDEscape(qdf.Name) & "`(接続先:`" & MDEscape(Left(qdf.Connect, 70)) & IIf(Len(qdf.Connect) > 70, "...", "") & "`)"
            foundExternal = True
        End If
    Next qdf
    If Not foundExternal Then Print #FileNum, "*明示的なリンクテーブルや外部接続クエリは見つかりませんでした。*" & vbCrLf
    Print #FileNum, ""

    Print #FileNum, "### VBAコード内の外部接続・ファイル操作・連携の可能性"
    Print #FileNum, ""
    Print #FileNum, "**注:** VBAコード内で動的に外部データベース接続、ファイル入出力、API連携、メール送信などを行っている可能性があります。"
    Print #FileNum, "以下のキーワードやオブジェクトを含むコードを詳細分析し、移行時の影響を確認してください:"
    Print #FileNum, ""
    Print #FileNum, "- **DAO (外部DB):**`OpenDatabase`,`DBEngine.Workspaces(0).OpenDatabase`"
    Print #FileNum, "- **ADODB:**`CreateObject(""; ADODB.Connection "")`,`ADODB.Recordset`,`ADODB.Command`"
    Print #FileNum, "- **ファイル操作:**`Open`,`Close`,`Print #`,`Input #`,`Line Input #`,`FreeFile`,`Name`,`Kill`,`Dir`,`CreateObject(""; Scripting.FileSystemObject "")`"
    Print #FileNum, "- **データ転送:**`DoCmd.TransferSpreadsheet`,`DoCmd.TransferText`,`DoCmd.TransferDatabase`"
    Print #FileNum, "- **エクスポート/メール:**`DoCmd.OutputTo`,`DoCmd.SendObject`"
    Print #FileNum, "- **オートメーション:**`CreateObject`(例:`Excel.Application`,`Word.Application`,`Outlook.Application`)"
    Print #FileNum, "- **API関数呼び出し:**`Declare Function/Sub`ステートメント (特にネットワーク、ファイル、レジストリ関連)"
    Print #FileNum, ""
    Print #FileNum, "---"
    Print #FileNum, ""
End Sub

' --- 9. アプリケーションレベルのセキュリティモデル分析 (推測) (Markdown) ---
Sub IntegratedAnalyzeSecurityModelMD(ByVal FileNum As Integer)
    Dim db As DAO.Database
    Dim tdf As DAO.TableDef
    Dim fld As DAO.Field
    Dim frmObj As AccessObject
    Dim foundSomething As Boolean
    Set db = CurrentDb
    
    Print #FileNum, "## 9. アプリケーションレベルのセキュリティモデル分析 (推測)"
    Print #FileNum, ""
    Print #FileNum, "**注:** ここでの分析はオブジェクト名からの推測です。実際のセキュリティ実装はVBAコードやテーブル構造の詳細な確認が必要です。"
    Print #FileNum, "Access標準のワークグループセキュリティ (`.mdw`) が使用されている場合は、別途確認してください。"
    Print #FileNum, ""

    Print #FileNum, "### ユーザー管理・権限管理に関連しそうなテーブル候補"
    Print #FileNum, ""
    foundSomething = False
    For Each tdf In db.TableDefs
        If Left(tdf.Name, 4) <> "MSys" And Left(tdf.Name, 1) <> "~" Then
            If InStr(1, tdf.Name, "User", vbTextCompare) > 0 Or _
               InStr(1, tdf.Name, "Login", vbTextCompare) > 0 Or _
               InStr(1, tdf.Name, "Auth", vbTextCompare) > 0 Or _
               InStr(1, tdf.Name, "Security", vbTextCompare) > 0 Or _
               InStr(1, tdf.Name, "Member", vbTextCompare) > 0 Or _
               InStr(1, tdf.Name, "Account", vbTextCompare) > 0 Or _
               InStr(1, tdf.Name, "Password", vbTextCompare) > 0 Or _
               InStr(1, tdf.Name, "Role", vbTextCompare) > 0 Or _
               InStr(1, tdf.Name, "Privilege", vbTextCompare) > 0 Or _
               InStr(1, tdf.Name, "Permission", vbTextCompare) > 0 Then
                foundSomething = True
                Print #FileNum, "- **候補テーブル:**`" & MDEscape(tdf.Name) & "`"
                Print #FileNum, "  - **フィールド:**"
                For Each fld In tdf.Fields
                    Print #FileNum, "    -`" & MDEscape(fld.Name) & "`(" & MDEscape(GetFieldType(fld.Type)) & ")"
                Next fld
                Print #FileNum, ""
            End If
        End If
    Next tdf
    If Not foundSomething Then Print #FileNum, "*明確なユーザー/権限管理テーブル候補は見つかりませんでした。*" & vbCrLf
    Print #FileNum, ""
    
    Print #FileNum, "### ログイン処理に関連しそうなフォーム候補"
    Print #FileNum, ""
    foundSomething = False
    For Each frmObj In CurrentProject.AllForms
        If InStr(1, frmObj.Name, "Login", vbTextCompare) > 0 Or _
           InStr(1, frmObj.Name, "Logon", vbTextCompare) > 0 Or _
           InStr(1, frmObj.Name, "Auth", vbTextCompare) > 0 Or _
           InStr(1, frmObj.Name, "Security", vbTextCompare) > 0 Or _
           InStr(1, frmObj.Name, "Password", vbTextCompare) > 0 Or _
           InStr(1, frmObj.Name, "SignIn", vbTextCompare) > 0 Then
            foundSomething = True
            Print #FileNum, "- **候補フォーム:**`" & MDEscape(frmObj.Name) & "`"
        End If
    Next frmObj
    If Not foundSomething Then Print #FileNum, "*明確なログインフォーム候補は見つかりませんでした。*" & vbCrLf
    Print #FileNum, ""
    
    Print #FileNum, "モジュール分析 (セクション6) も参照し、セキュリティ関連の役割が推測されるモジュールを確認してください。"
    Print #FileNum, ""
    Print #FileNum, "---"
    Print #FileNum, ""
End Sub

' --- 10. オブジェクト依存関係 (Access標準機能への誘導) (Markdown) ---
Sub IntegratedAnalyzeDependenciesMD(ByVal FileNum As Integer)
    Print #FileNum, "## 10. オブジェクト依存関係の詳細分析"
    Print #FileNum, ""
    Print #FileNum, "Accessの標準機能を使用してオブジェクト間の依存関係を詳細に確認できます。"
    Print #FileNum, "移行計画において、機能の関連性を把握するために非常に重要です。"
    Print #FileNum, "以下のいずれかの機能を使用してください："
    Print #FileNum, ""
    Print #FileNum, "1. **[データベースツール]** タブ → **[リレーションシップ]** グループ → **[オブジェクトの依存関係]**"
    Print #FileNum, "2. **[データベースツール]** タブ → **[分析]** グループ → **[データベース構造の解析]** (データベースドキュメンター)"
    Print #FileNum, ""
    Print #FileNum, "これらのツールは、GUIを通じて視覚的に依存関係を把握するのに役立ちます。"
    Print #FileNum, ""
    Print #FileNum, "---"
    Print #FileNum, ""
End Sub


' --- ユーティリティ関数群 (変更なし、MDEscape関数を追加) ---

Function GetStartupForm() As String
    Dim prop As DAO.Property
    On Error Resume Next
    GetStartupForm = CurrentDb.Properties("StartupForm").Value
    If Err.Number <> 0 Then GetStartupForm = "未設定": Err.Clear
    On Error GoTo 0
End Function

Function GetDisplayForm() As String
    Dim prop As DAO.Property
    Dim propValue As Variant
    On Error Resume Next
    propValue = CurrentDb.Properties("StartupShowDBWindow").Value
    If Err.Number <> 0 Then
        GetDisplayForm = "未設定 (デフォルトはデータベースウィンドウ)"
        Err.Clear
    Else
        If propValue = True Then
            GetDisplayForm = "データベースウィンドウ"
        Else
            GetDisplayForm = "スタートアップフォーム (設定されていれば)"
        End If
    End If
    On Error GoTo 0
End Function

Function GetNavPaneDisplay() As String
    Dim prop As DAO.Property
    Dim propValue As Variant
    On Error Resume Next
    propValue = CurrentDb.Properties("ShowNavigationPane").Value
    If Err.Number <> 0 Then
        GetNavPaneDisplay = "デフォルトまたは未設定 (通常は表示)"
        Err.Clear
    Else
        If propValue = True Then
            GetNavPaneDisplay = "表示"
        Else
            GetNavPaneDisplay = "非表示"
        End If
    End If
    On Error GoTo 0
End Function

Function IsFormLoaded(FormName As String) As Boolean
    Dim obj As Object
    IsFormLoaded = False
    For Each obj In Forms
        If obj.Name = FormName Then IsFormLoaded = True: Exit Function
    Next obj
End Function

Function IsReportLoaded(ReportName As String) As Boolean
    Dim obj As Object
    IsReportLoaded = False
    For Each obj In Reports
        If obj.Name = ReportName Then IsReportLoaded = True: Exit Function
    Next obj
End Function

Function HasCode(ObjectType As AcObjectType, ObjectName As String) As Boolean
    Dim vbComp As Object, vbProj As Object
    On Error Resume Next
    HasCode = False
    'Set vbProj = Application.CodeProject
    Set vbProj = Application.VBE.ActiveVBProject
    If vbProj Is Nothing Then Exit Function
    Set vbComp = vbProj.VBComponents(ObjectName)
    If Err.Number = 0 Then
        If Not vbComp Is Nothing Then
            If vbComp.CodeModule.CountOfLines > 1 Then HasCode = True
        End If
    Else: Err.Clear
    End If
    Set vbComp = Nothing: Set vbProj = Nothing
    On Error GoTo 0
End Function

Function CountControls(obj As Object, ControlTypeName As String) As Integer
    Dim ctl As Control, count As Integer: count = 0
    If obj Is Nothing Then Exit Function
    On Error Resume Next
    For Each ctl In obj.Controls
        If TypeName(ctl) = ControlTypeName Then count = count + 1
    Next ctl
    On Error GoTo 0
    CountControls = count
End Function

Function GetQueryType(TypeNum As Integer) As String
    Select Case TypeNum
        Case dbQSelect: GetQueryType = "選択クエリ"
        Case dbQAction: GetQueryType = "アクションクエリ (総称)"
        Case dbQCrosstab: GetQueryType = "クロス集計クエリ"
        Case dbQDelete: GetQueryType = "削除クエリ"
        Case dbQUpdate: GetQueryType = "更新クエリ"
        Case dbQAppend: GetQueryType = "追加クエリ"
        Case dbQMakeTable: GetQueryType = "テーブル作成クエリ"
        Case dbQDDL: GetQueryType = "データ定義クエリ (DDL)"
        Case dbQSQLPassThrough: GetQueryType = "SQLパススルークエリ"
        Case Else: GetQueryType = "不明なクエリタイプ (" & TypeNum & ")"
    End Select
End Function

Function GetFieldType(TypeNum As Integer) As String
    Select Case TypeNum
        Case dbBoolean: GetFieldType = "はい/いいえ (Boolean)"
        Case dbByte: GetFieldType = "バイト (Byte)"
        Case dbInteger: GetFieldType = "整数 (Integer)"
        Case dbLong: GetFieldType = "長整数 (Long)"
        Case dbCurrency: GetFieldType = "通貨 (Currency)"
        Case dbSingle: GetFieldType = "単精度浮動小数点 (Single)"
        Case dbDouble: GetFieldType = "倍精度浮動小数点 (Double)"
        Case dbDate: GetFieldType = "日付/時刻 (Date/Time)"
        Case dbBinary: GetFieldType = "バイナリ (Binary)"
        Case dbText: GetFieldType = "短いテキスト (Text)"
        Case dbLongBinary: GetFieldType = "長いテキスト/OLE (LongText/OLE Object)"
        Case dbMemo: GetFieldType = "長いテキスト (Memo)"
        Case dbGUID: GetFieldType = "レプリケーション ID (GUID)"
        Case dbBigInt: GetFieldType = "大きな数値 (BigInt)"
        Case dbVarBinary: GetFieldType = "可変長バイナリ (VarBinary)"
        Case dbChar: GetFieldType = "固定長テキスト (Char)"
        Case dbNumeric: GetFieldType = "数値 (Numeric)"
        Case dbDecimal: GetFieldType = "10進数 (Decimal)"
        Case dbFloat: GetFieldType = "浮動小数点 (Float)"
        Case Else: GetFieldType = "その他/不明 (" & TypeNum & ")"
    End Select
End Function

Function MDEscape(TextToEscape As String) As String
    ' Markdownで特別な意味を持つ文字をエスケープする関数
    ' バッククォート(`)で囲まれた部分はエスケープの対象外とする
    
    Dim EscapedText As String
    Dim parts() As String
    Dim i As Long
    Dim inBackticks As Boolean
    
    EscapedText = ""
    
    ' エスケープ機能はいったん無効化
    ' エスケープ機能を有効にしたい場合は下の1行を削除し、以降のコメントアウトを外す
    MDEscape = TextToEscape

'    ' バッククォートで文字列を分割
'    parts = Split(TextToEscape, "`")
'
'    ' 分割された各部分を処理
'    ' 最初の部分は常にバッククォートの外側（または文字列全体がバッククォートで始まらない場合）
'    inBackticks = False
'
'    For i = 0 To UBound(parts)
'        If inBackticks Then
'            ' バッククォートの内側の部分：そのまま追加し、区切り文字のバッククォートも復元
'            EscapedText = EscapedText & "`" & parts(i)
'            If i < UBound(parts) Then ' 最後の部分でなければ、閉じるバッククォートも追加
'                 EscapedText = EscapedText & "`"
'            ElseIf TextToEscape Like "*`" Then ' 元の文字列がバッククォートで終わっている場合
'                 EscapedText = EscapedText & "`"
'            End If
'        Else
'            ' バッククォートの外側の部分：エスケープ処理を適用
'            Dim tempPart As String
'            tempPart = parts(i)
'
'            ' \ (バックスラッシュ) は他のエスケープ文字より先に処理
'            tempPart = Replace(tempPart, "\", "\\")
'
'            ' Markdown特殊文字のエスケープ (主要なもの)
'            ' バッククォート自体は、このロジックでは分割に使われるため、
'            ' 外側の部分で単独で出現するバッククォートはエスケープ不要（または別途考慮が必要だが、
'            ' 通常はバッククォートで囲む用途なので、外側で単独は稀）
'            ' ここでは、元のコードのエスケープ対象文字からバッククォートを除外する
'            ' tempPart = Replace(tempPart, "`", "\`") ' バッククォートのエスケープはしない
'
'            tempPart = Replace(tempPart, "*", "\*") ' アスタリスク
'            tempPart = Replace(tempPart, "_", "\_") ' アンダースコア
'            tempPart = Replace(tempPart, "{", "\{") ' 波括弧（左）
'            tempPart = Replace(tempPart, "}", "\}") ' 波括弧（右）
'            tempPart = Replace(tempPart, "[", "\[") ' 角括弧（左）
'            tempPart = Replace(tempPart, "]", "\]") ' 角括弧（右）
'            tempPart = Replace(tempPart, "(", "\(") ' 丸括弧（左）
'            tempPart = Replace(tempPart, ")", "\)") ' 丸括弧（右）
'            tempPart = Replace(tempPart, "#", "\#") ' ハッシュ
'            tempPart = Replace(tempPart, "+", "\+") ' プラス
'            tempPart = Replace(tempPart, "-", "\-") ' マイナス（ハイフン）
'            tempPart = Replace(tempPart, ".", "\.") ' ドット（ピリオド）
'            tempPart = Replace(tempPart, "!", "\!") ' 感嘆符
'            tempPart = Replace(tempPart, "|", "\|") ' パイプ (テーブル用)
'
'            EscapedText = EscapedText & tempPart
'
'            ' 次の部分がバッククォートの内側であれば、開始のバッククォートを追加
'            If i < UBound(parts) And Not inBackticks Then
'                ' この条件は、バッククォートが対になっている前提
'                ' ここでバッククォートを追加すると、inBackticks=Trueのブロックで二重に追加される可能性があるため、
'                ' バッククォートの復元は inBackticks=True のブロックに任せる。
'            End If
'        End If
'
'        ' バッククォートの内外を交互に切り替え
'        ' ただし、partsの要素が奇数個なら最後の要素はバッククォートの外、
'        ' 偶数個なら最後の要素はバッククォートの内（元の文字列がバッククォートで終わっていない場合）
'        ' この単純なトグルでは、ネストしたバッククォートやエスケープされたバッククォートには対応できない
'        ' ここでは、単純な「`text`」のペアを想定
'        inBackticks = Not inBackticks
'    Next i
'
'    MDEscape = EscapedText

End Function

概要

このソースコードは、Access VBAで記述された一連のプロシージャと関数から成り立っています。メインプロシージャGenerateMdbAnalysisReportMarkdownが全体の処理を統括し、データベースの様々な側面（スタートアップ設定、テーブル、クエリ、フォーム、レポート、モジュール、マクロ、外部接続、セキュリティモデルの推測、依存関係分析の推奨など）を分析するための専用サブプロシージャを呼び出します。

各分析サブプロシージャは、収集した情報をMarkdownの書式ルールに従って整形し、指定されたファイルに出力します。これにより、オブジェクト名、SQL文、VBAコードの有無、各種設定値などが、見出し、リスト、太字、インラインコード、コードブロックといったMarkdown要素を駆使して表現され、構造的かつ視覚的に優れたレポートが生成されます。

最終的に、データベースファイルと同じフォルダにMigrationAnalysisReport.mdという名前のMarkdownファイルが出力されます。このレポートは、Markdownに対応したビューアやエディタで閲覧することで、その真価を発揮します。

各プロシージャ・関数の機能解説

1.Sub GenerateMdbAnalysisReportMarkdown()

2.Sub IntegratedAnalyzeStartupSettingsMD(ByVal FileNum As Integer)

3.Sub IntegratedAnalyzeTablesMD(ByVal FileNum As Integer)

4.Sub IntegratedAnalyzeQueriesMD(ByVal FileNum As Integer)

5.Sub IntegratedAnalyzeFormsMD(ByVal FileNum As Integer)

6.Sub IntegratedAnalyzeReportsMD(ByVal FileNum As Integer)

7.Sub IntegratedAnalyzeModulesMD(ByVal FileNum As Integer)

8.Sub IntegratedAnalyzeMacrosMD(ByVal FileNum As Integer)

9.Sub IntegratedAnalyzeExternalConnectionsMD(ByVal FileNum As Integer)

10.Sub IntegratedAnalyzeSecurityModelMD(ByVal FileNum As Integer)

11.Sub IntegratedAnalyzeDependenciesMD(ByVal FileNum As Integer)

12. ユーティリティ関数群

当ソースコードの利用手順

  1. Accessデータベースを開く：分析対象のAccessファイル（.mdbまたは.accdb）を開きます。
  2. VBAエディタを開く:Alt+F11キー、またはリボンの「データベースツール」→「Visual Basic」。
  3. コードを追加：分析するためには対象のAccessにコードを追加します。追加方法は2パターンあります。
    • ソースコードを貼り付け：VBAエディタの「挿入」→「標準モジュール」。オブジェクト名は任意ですが、「analyze_mdb」などわかりやすい名称を設定することを推奨します。新しい標準モジュールに、提供されたVBAソースコード全体を手でコピー＆ペーストし保存します。
    • ファイルをインポート：VBE上で標準モジュールを右クリックし、表示されたメニュー内の「ファイルをインポート」を選択します。インポート対象は当リポジトリのAnalyze_mdb_MDVer.basです。インポートすると新規で標準モジュールが作成されます。
  4. 参照設定の確認と設定：VBAエディタの「ツール」→「参照設定」で、以下がチェックされていることを確認します。
    • 必須：Microsoft Office XX.0 Access database engine Object Library
    • 任意：Microsoft Visual Basic for Applications Extensibility 5.3
  5. コードの実行：VBAエディタでSub GenerateMdbAnalysisReportMarkdown()内の任意の行にカーソルを置き、F5キーを押すか実行ボタンをクリックします。
  6. レポートファイルの確認：実行完了後、Accessデータベースファイルと同じフォルダにMigrationAnalysisReport.mdが生成されます。このファイルをMarkdown対応のビューアやエディタで開いて内容を確認します。

当ソースコードを利用する際の注意点

これらの点を理解した上で、本ツールをご活用ください。

Todo

参考

  1. Access VBA リファレンス
comments powered by Disqus