ソースコードの行数をカウントするVBAマクロ
前回に続きVBAに関する記事。
いきなり巨大なZIPファイルを渡され、ソースコードの行数をカウントしてほしいとのオーダーがあった。
いやいやちょっと待て。VS Code Counter使えば一瞬だろと突っ込んだが、何故かやってくれない。ベンダーに聞けばいいじゃんっていえば、ごにょごにょいって対応してくれない。
- 全てベンダーに丸投げで何もできない
- ちょっと調べればできることをやらない
こんな社員ばかりだから、DXがいつになっても成功しないのでは！？
コスト感覚も狂っていて、こんなどうでもいいソースコードのカウントをお高いお高いコンサルにお願いしようとする。こりゃコンサルが儲かるわけだわ。その依頼されたコンサルもソースコード書いたことないし、VSCode触ったこともないような人なので、時間がかかる。ソースコードをカウントするだけで、数十万円のコストがチャリーン。
現場では１円、１銭のコストを切り詰めているのに、少し離れたオシャレなオフィスでは、DXの名のもとに
数十万円どーん、数百万円どかーん、数千万円？意外に安いじゃーん
と湯水のようにお金が流れていく。実に不思議なことだ。
って前置きはおいといて、何故かネットにもつながらない、かつ、VSCodeがインストールされていない端末でソースコードをカウントするはめに。(お安い便利屋の宿命)
困ったときはVBAということで、スマホでググりながらソースコードを書くことに。
世の中にジャストフィットするサンプルがなかったので、このブログで紹介することにしました。(必要性があまりないので、当然といえば当然ですが、、、）
★注意点★
コメントとか空行とかは１行としてカウントします。真剣にやればできたかもしれませんが、正直めんどくさかったので、何もこだわっていないです。
[ソースコードをカウントするマクロ]
＜準備①＞
B2にカウントしたい対象の親フォルダのパスを入力。
B4～F4にラベルを入力。以下イメージ。
＜準備②＞
Alt+F11でマクロの編集画面を開き、ツール→参照設定で、”Microsoft Scripting Runtime"にチェックを入れる。
＜準備③＞
以下のコードを標準モジュールに貼り付ける。
Sub getFileList(searchPath)
Dim fso As New FileSystemObject
Dim objFiles As File
Dim objFolders As Folder
Dim separateNum As Integer
'サブフォルダの取得
For Each objFolders In fso.GetFolder(searchPath).SubFolders
Call getFileList(objFolders.Path)
Next
'ファイル名の取得
For Each objFiles In fso.GetFolder(searchPath).Files
separateNum = InStrRev(objFiles.Path, "\")
'ファイルの情報を書き込む
ActiveCell.Value = Left(objFiles.Path, separateNum - 1)
ActiveCell.Offset(0, 1).Value = Right(objFiles.Path, Len(objFiles.Path) - separateNum)
ActiveCell.Offset(0, 2).Value = FileDateTime(objFiles)
ActiveCell.Offset(0, 3).Value = Format（（FileLen(objFiles) / 1024), "#.0") 書式崩れるのでカッコ大文字にしています。ご注意
'ファイルの行数をカウントする
Dim F_PATH As String
F_PATH = objFiles.Path
Dim fso1 As Scripting.FileSystemObject
Set fso1 = New Scripting.FileSystemObject
Dim ts As Scripting.TextStream
Set ts = fso1.OpenTextFile(Filename:=F_PATH, IOMode:=ForAppending)
ActiveCell.Offset(0, 4) = ts.Line
ts.Close
ActiveCell.Offset(1, 0).Select
Next
End Sub
Sub setFileList(searchPath)
Dim startCell As Range
Dim maxRow As Integer
Dim maxCol As Integer
Set startCell = Cells(5, 2) 'この位置から出力し始める
'シートをいったんクリア
startCell.Select
maxRow = startCell.SpecialCells(xlLastCell).Row
maxCol = startCell.SpecialCells(xlLastCell).Column
Range(startCell, Cells(maxRow, maxCol)).ClearContents
Call getFileList(searchPath)
startCell.Select
End Sub
Sub CommandButton_Click()
Call setFileList(Cells(2, 2))
End Sub
上記で準備完了。後は、 CommandButton_Clickを実行するだけ。実行結果のイメージは以下。
彼らはこの実行結果を何に使うのだろうか。。。(´・ω・`)
