No.1529　条件に一致するファイルの一覧を出力　その２

旅の始まり

No.1528 条件に一致するファイル一覧を出力その１ - スナックelve 本店
さくさくになったぜ！　と思ったのもつかの間。ファイルを目立たせたい、とUnicodeの記号を使われていたため
f:id:elve:20180301194611p:plain

実行時エラー '52':
ファイル名または番号が不正です。

”❀-20130103015714.jpg”の先頭の記号が?（クエスチョンマーク）に置き換わり、"?-20130103015714.jpg"ファイルなんてない、とエラーを吐くのだ・・・。
FSOは重い、dirはUnicodeに対応してない（？）。俺はどうすれば・・・。
こうなったら、DOSコマンド使うしかないじゃない！！
こうして長い旅が始まったのじゃよ。

結果だけ書くと楽勝っぽい

ググって出てきたのはこちら
Office TANAKA - Excel VBA Tips[MS-DOSコマンドの標準出力を取得する]

φ(ﾟДﾟ )ﾌﾑﾌﾑ…またコメントそのままで使うけど
アレをこうしてこうじゃ！！

Sub getFileListWSH(searchPath)

    Dim FSO As New FileSystemObject
    Dim objFiles As File
    Dim objFolders As Folder
    Dim separateNum As Long

    'サブフォルダ取得
    For Each objFolders In FSO.GetFolder(searchPath).SubFolders
        Call getFileListWSH(objFolders.Path)
    Next
    
    Dim WSH, wExec, sCmd As String, Result As String
    Set WSH = CreateObject("WScript.Shell")         ''(1)
    WSH.CurrentDirectory = searchPath
    
    sCmd = "dir *.jpg /A-D/B"                                ''(2)
    Set wExec = WSH.Exec("%ComSpec% /c " & sCmd)    ''(3)
    Do While wExec.Status = 0                       ''(4)
        DoEvents
        Do
           Result = wExec.StdOut.ReadLine                   ''(5)
           If Result = "" Then Exit Do
           ActiveCell.Value = searchPath
           ActiveCell.Offset(0, 1).Value = Result
           ActiveCell.Offset(1, 0).Select
        Loop
    Loop
    Do
       Result = wExec.StdOut.ReadLine                   ''(5)
       If Result = "" Then Exit Do
       ActiveCell.Value = searchPath
       ActiveCell.Offset(0, 1).Value = Result
       ActiveCell.Offset(1, 0).Select
    Loop
    Set wExec = Nothing
    Set WSH = Nothing

    
End Sub