スナックelve 本店

バツイチ派遣40代女性の日記です

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

旅の始まり

No.1528 条件に一致するファイル一覧を出力 その1 - スナック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

f:id:elve:20180301203105p:plain

ドハマリポイント

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

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

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

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

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

余談

職場でこういうの作るときネットにつなげる環境と作業したい環境が別で用意されてるのでコピペができないのよねぇ~(;´Д`)