ファイル名取得(昇順).vbs

ファイル名取得(昇順)

' エクスプローラーで選択したファイル（複数可）をこのアイコンにDrag&Dropすると、
' ファイル名（またはパス）をソートしてクリップボードにコピーする。
' SendToフォルダにこのファイルを置くと、選択したファイルの右クリックメニューの
' ［送る］でパスを取得できる。
' エクスプローラーのアドレスバーにshell:sendtoを入力すると飛べる。
' ※ 一度に選択できるファイル数の上限：パスの総文字数が32,699未満（Windows7、10の場合）

Option Explicit

Dim args              '// 選択したファイルパスの配列
Dim folderPath        '// フォルダのパス
Dim i                 '// 配列のループカウンタ
Dim fileNames         '// ソート前のフルパスリスト
Dim fileNamesArray    '// ソートされたフルパスの配列
Dim sortFileNames     '// ソートされたフルパスリスト
Dim msg               '// パスかファイル名かの選択メッセージ

Set args = WScript.Arguments

'// D&Dした複数ファイルのフルパスを改行で繋いだリスト（文字列）にする
folderPath = CreateObject("Scripting.FileSystemObject").GetParentFolderName(args(0)) & "\"

For i = 0 to args.Count - 2
    fileNames = fileNames & args(i) & vbcrlf
next

fileNames = fileNames & args(i) '// 末尾に改行を入れないようにするため、最後はループから外す

Set args = Nothing

'// フルパスを配列にしてソートする（フルパスは2次元目に格納されている）
fileNamesArray = SortRecordset(Split(fileNames, vbcrlf))

'// ソートされた配列を改行で繋いだリスト（文字列）にする
For i = 0 to UBound(fileNamesArray, 2)
    sortFileNames = sortFileNames & fileNamesArray(0, i) & vbcrlf
next

'msg = "フォルダのパスも含めますか？" & vbcrlf & vbcrlf
'msg = msg & "［はい］フルパス" & vbcrlf & "［いいえ］ファイル名のみ"

'If Msgbox(msg, vbYesNo) = vbNo Then
    sortFileNames = Replace(sortFileNames, folderPath, "")
'End If

CreateObject("WScript.Shell").Exec("clip").StdIn.Write(sortFileNames)   '// クリップボードにコピー
WScript.Echo "以下のファイル名リストをコピーしました。" & vbcrlf & vbcrlf & sortFileNames


'// ソート関数
Function SortRecordset(arry)
    Dim i
    With CreateObject("ADODB.Recordset")
        .Fields.Append "Field1", 200, 2047      '// 引数は、順にカラム名、型、文字バイト数
        .Open

        '// データをレコードセットに追加していく
        For i = 0 To UBound(arry)
            .AddNew
            .Fields("Field1").Value = arry(i)
        Next

        .Sort = "Field1 ASC"        '// ASC(昇順)／DESC(降順) ※省略した場合は昇順
        SortRecordset = .GetRows    '// GetRowsは2次元配列を返すので要注意
        .Close
    End With
End Function