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
