2023年6月12日月曜日

【VBScript】指定したフォルダのファイル・フォルダを再帰的にエクセルファイルに出力

event_note6月 12, 2023

フォルダ内のファイルをリストにして確認するスクリプトです。

下記のスクリプトをXXX(任意のファイル名).vbsで保存します。

保存したファイルをクリックすると、入力画面が表示されるので、調べたいフォルダのパスを入力して、OKを押してください。

すると、vbsがあるフォルダの中に、Files.xlsxという名前でファイルリストが作成されます。


Set objFS = CreateObject("Scripting.FileSystemObject")
Set objExcel = CreateObject("Excel.Application")

objExcel.Visible = True

Set objWorkbook = objExcel.Workbooks.Add()
Set objWorksheet = objWorkbook.Sheets(1)


' ヘッダー行の設定
objWorksheet.Cells(1, 1).Value = "フォルダパス"
objWorksheet.Cells(1, 2).Value = "ファイルパス"

intRow = 2 ' データ行の開始位置

' ユーザーからの入力を受け取る
strInput = InputBox("ファイルパスを入力:", "入力")

strFolderPath = strInput ' フォルダのパスを指定


' フォルダ内のファイルとフォルダを処理
ProcessFolder strFolderPath

' 出力したデータを自動調整
objWorksheet.UsedRange.Columns.AutoFit

' エクセルファイルを保存
' 実行中のスクリプトファイルのフルパスを取得
strScriptPath = WScript.ScriptFullName
 
' スクリプトファイルのディレクトリパスを取得
strScriptFolder = objFS.GetParentFolderName(strScriptPath)



strOutputFilePath = strScriptFolder & "\Files.xlsx" ' 出力先のファイルパスを指定
objWorkbook.SaveAs strOutputFilePath

' オブジェクトの参照を解放
Set objWorksheet = Nothing
objWorkbook.Close
objExcel.Quit
Set objExcel = Nothing

Set objFS = Nothing

'================================================================
' フォルダ内のファイルとサブフォルダを再帰的に処理するサブルーチン
'----------------------------------------------------------------
Sub ProcessFolder(strFolderPath)
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objFSO.GetFolder(strFolderPath)
    
    ' フォルダ内のファイルを処理
    For Each objFile In objFolder.Files
        ' ファイルパスを出力
        objWorksheet.Cells(intRow, 2).Value = objFile.Path
        intRow = intRow + 1
    Next
    
    ' サブフォルダを再帰的に処理
    For Each objSubFolder In objFolder.SubFolders
        ' フォルダパスを出力
        objWorksheet.Cells(intRow, 1).Value = objSubFolder.Path
        intRow = intRow + 1
        
        ' サブフォルダ内のファイルとサブフォルダを再帰的に処理
        ProcessFolder objSubFolder.Path
    Next
    
    ' オブジェクトの参照を解放
    Set objSubFolder = Nothing
    Set objFile = Nothing
    Set objFolder = Nothing
    Set objFSO = Nothing
End Sub
'==============================================================