旅の始まり

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

実行時エラー ’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

ドハマリポイント

呼んだ命令が帰ってこないのでハマった
Somewhere in a Way to Nowhere: WshShellのExecで実行したコマンドが終了しない

標準出力のサイズが4096バイトを超える場合に、標準出力の読み出しをせずに終了待ちしていると止まってしまうようです。

Somewhere in a Way to Nowhere: WshShellのExecで実行したコマンドが終了しない

なので読み→出力を2箇所で行ってる(5)

うーむ、職場で作った奴は2箇所で読むようにしてないのだが動いてるんだろうか(；´Д｀)