選択したフォルダ（サブフォルダも）のファイルリストを出力するVBScript

みんな大好き再起呼び出し

以下のスクリプトをSendToフォルダに入れておくと一瞬でファイルリストを生成できる。

選択したフォルダ（サブフォルダも）のファイルリストを出力する.vbs

Option Explicit

Dim startTime
startTime = Timer

Dim arg
For Each arg In WScript.Arguments
    Dim txtFileName, txtFilePath, txtFile
    With CreateObject("Scripting.FileSystemObject")
        txtFileName = "FileList［" & .GetFileName(.GetParentFolderName(arg)) & "≫"
        txtFileName = txtFileName & .GetFileName(arg)
        txtFileName = txtFileName & "］" & DateFormat(Now, "yyyy-mm-dd_hhnnss") & ".txt"
        txtFilePath = .BuildPath(MakeFolder("C:\temp\ファイルリスト出力"), txtFileName)
        Set txtFile = .OpenTextFile(txtFilePath, 2, True)
    End With

    Call CreateFileList(arg, txtFile)
    txtFile.Close
    CreateObject("WScript.Shell").Run txtFilePath
Next

Set txtFile = Nothing

Msgbox " 出力完了！（" & GetLapTime(startTime) & "）", 64, "処理完了"

'// 作成したフォルダのパスを返す
'// mdコマンドを使うことで、すでにフォルダが存在していてもエラーにならないし、
'// 途中のフォルダも自動的に作成してくれる

Function MakeFolder(ByVal folder_path)

    CreateObject("WScript.Shell").Run "cmd /c md " & chr(34) & folder_path & chr(34), 0, True
    MakeFolder = folder_path

End Function

'// ファイルパス書き込み

Sub CreateFileList(folder_path, txt_file)

    Dim fl, fd

    With CreateObject("Scripting.FileSystemObject")
        With .GetFolder(folder_path)
            For Each fl In .Files
                txt_file.WriteLine(fl.Path)
            Next

            '' 再帰呼び出し
            For Each fd In .SubFolders
                Call CreateFileList(fd.Path, txt_file)
            Next
        End With
    End With

End Sub

'// フォルダを開く

Sub OpenFolder(Byval path)

    Dim optn: optn = ""
    If CreateObject("Scripting.FileSystemObject").FileExists(path) Then optn = "/select, "
    CreateObject("WScript.Shell").Run "explorer.exe /e, " & optn & path, 1

End Sub

'// 計測時間（分秒）を返す。

Function GetLapTime(ByVal start_time)

    Dim lapTime, m, s, f

    lapTime = Timer - start_time
    m = Int(lapTime / 60)
    s = Int(lapTime) Mod 60
    f = Int((lapTime - Int(lapTime)) * 100)

    GetLapTime = m & " 分 " & s & " 秒 " & f

End Function

'// 日付を fmt 形式の文字列で返す
'// "yyyy"は西暦4桁、"yy"は西暦下2桁、"y"は和暦、"0y"は和暦0付き、gは元号（明治以前は西暦）
'// "m"、"d"、"h"、"n"、"s" は 月、日、時、分、秒（二文字の場合は0つき2桁）
'// "aaa"は曜日、"a"はその略字

Function DateFormat(ByVal date_value, ByVal fmt)

    Dim yyyy, yy, y, g, mm, m, dd, d, hh, h, nn, n, ss, s, aaa, a

    yyyy = Year(date_value)
    m = Month(date_value)
    d = Day(date_value)
    h = Hour(date_value)
    n = Minute(date_value)
    s = Second(date_value)
    aaa = WeekdayName(Weekday(date_value))

    yy = Right(yyyy, 2)
    mm = Right("0" & m, 2)
    dd = Right("0" & d, 2)
    hh = Right("0" & h, 2)
    nn = Right("0" & n, 2)
    ss = Right("0" & s, 2)
    a = Left(aaa, 1)

    fmt = Replace(fmt, "yyyy", yyyy)
    fmt = Replace(fmt, "yy", yy)

    If date_value < #1868/9/4# Then g = "": y = yyyy
    If date_value >= #1868/9/4# Then g = "明治": y = yyyy - 1867
    If date_value >= #1912/7/31# Then g = "大正": y = yyyy - 1911
    If date_value >= #1926/12/27# Then g = "昭和": y = yyyy - 1925
    If date_value >= #1989/1/8# Then g = "平成": y = yyyy - 1988
    If date_value >= #2019/5/1# Then g = "令和": y = yyyy - 2018

    fmt = Replace(fmt, "0y", g & Right("0" & y, 2))
    If y = 1 Then y = "元"
    fmt = Replace(fmt, "y", g & y)

    fmt = Replace(fmt, "mm", mm)
    fmt = Replace(fmt, "dd", dd)
    fmt = Replace(fmt, "hh", hh)
    fmt = Replace(fmt, "nn", nn)
    fmt = Replace(fmt, "ss", ss)
    fmt = Replace(fmt, "aaa", aaa)

    fmt = Replace(fmt, "m", m)
    fmt = Replace(fmt, "d", d)
    fmt = Replace(fmt, "h", h)
    fmt = Replace(fmt, "n", n)
    fmt = Replace(fmt, "s", s)
    fmt = Replace(fmt, "a", a)

    DateFormat = fmt

End Function