' ＜参照設定＞
' Microsoft Visual Basic for Applications Extensibility

Option Compare Database
Option Explicit

Sub ExportProcedureListWithLineCount()

    On Error GoTo ErrCatch
    
    Dim fso As Object
100 Set fso = CreateObject("Scripting.FileSystemObject")
    
    Dim countBlank As Boolean   '-- 空行をカウントするかどうか
110 countBlank = False

    Dim listFileName As String  '-- プロシージャリストのファイル名
    Dim listFilePath As String  '-- プロシージャリストのバス
    Dim fileStream   As Object  '-- ファイル出力するための Streamオブジェクト

120 listFileName = "［" & fso.GetBaseName(CurrentProject.Name) & "］ProcedureList"
130 listFileName = listFileName & Format(Now, "［yyyy-mm-dd］ hhnnss") & ".csv"
140 listFilePath = fso.BuildPath(CurrentProject.path, listFileName)

150 Set fileStream = fso.CreateTextFile(listFilePath, True)

    Dim lineCntHdr As String
160 lineCntHdr = "空行除く行数"
170 If countBlank Then lineCntHdr = "行数"

180 fileStream.WriteLine "モジュール名.プロシージャ名," & lineCntHdr    '-- ヘッダ行

    Dim vbComp     As VBIDE.VBComponent     '-- VBE（Visual Basic Editor）を操作するためのオブジェクト
    Dim codeMod    As VBIDE.CodeModule      '-- コードモジュールを操作するためのオブジェクト
    Dim procType   As VBIDE.vbext_ProcKind  '-- プロシージャの種類を識別するための列挙型

    Dim procName   As String    '-- プロシージャ名
    Dim startLine  As Long      '-- プロシージャの開始行
    Dim procLines  As Long      '-- プロシージャの総行数
    Dim lineCount  As Long      '-- プロシージャの行数
    Dim totalLines As Long      '-- 全プロシージャの合計行数

    '' モジュールをループ
190 For Each vbComp In Application.VBE.ActiveVBProject.VBComponents
200    Set codeMod = vbComp.CodeModule

       Dim lineNum As Long
210    lineNum = 1

220    Do While lineNum < codeMod.CountOfLines '-- モジュール内の総行数
230        procName = codeMod.ProcOfLine(lineNum, procType)

240        If procName <> "" Then
                startLine = codeMod.ProcStartLine(procName, procType)
250             procLines = codeMod.ProcCountLines(procName, procType)
260             lineCount = 0

                '' 行数カウント (countBlank が False なら空行はカウントしない)
                Dim i As Long
270             For i = startLine To startLine + procLines - 1
280                 If countBlank Then
290                     lineCount = lineCount + 1
300                 Else
310                     If Trim(codeMod.Lines(i, 1)) <> "" Then
320                         lineCount = lineCount + 1
330                     End If
340                 End If
350             Next i

360             totalLines = totalLines + lineCount
370             fileStream.WriteLine vbComp.Name & "." & procName & "," & lineCount
380             lineNum = startLine + procLines
390         Else
400             lineNum = lineNum + 1
410         End If
420     Loop
430 Next vbComp
 
    '' 合計行数を出力
440 fileStream.WriteLine "合計," & totalLines
450 CreateObject("WScript.Shell").Run Chr(34) & listFilePath & Chr(34)

    GoTo Finally

ErrCatch:

    MsgBox "エラーが発生しました。", vbCritical
    
    Debug.Print "エラー箇所："; "ExportProcedureListWithLineCount"
    Debug.Print "行番号："; Erl
    Debug.Print "エラー内容："; Err.Description
    Debug.Print "エラー番号："; Err.Number
    Debug.Print "エラーソース："; Err.Source
    Resume Finally

Finally:
    
    On Error Resume Next
    fileStream.Close
    Set fileStream = Nothing
    Set codeMod = Nothing
    Set fso = Nothing

End Sub