エクセル vba DoEventsをぬける方法

質問

Ghostscriptでエクセルのコマンドラインを使ってPDFのファイルをTIFFのファイルに変換しています。PDFの一部のページが変換できない時、DoEventsでLoopしてしまいます。TIFFファイルはできているのですが Result.Statusが0のママで終了のフラグ 1 がたたないようです。Loopをぬける方法はないものでしょうか。

'PDFをTIFFにする　PDFMEIのPDFファイルをHENKANのTIFFファイルにする
cmd = XPATH & "gs\gs9.27\bin\gswin32c.exe -dSAFER -dBATCH -dNOPAUSE _
-sDEVICE=tiffgray -r200 -sOutputFile=" & XPATH & HENKAN & " " & XPATH & PDFMEI
Set Result = WSH.exec("%ComSpec% /c " & cmd)
Do While Result.Status = 0
DoEvents 'ココで止まってしまう
Loop

回答No.2

HohoPapa · ベストアンサー

付け焼刃で力技ですが、以下のようなコードはいかがでしょうか。
なお、MaxTry = 5　この値はテストを繰り返し調整してくださ。
1秒間隔で5回という意味です。

sub xxxxx()

　'～～～～～～

　cmd = XPATH & "gs\gs9.27\bin\gswin32c.exe -dSAFER -dBATCH -dNOPAUSE _
　-sDEVICE=tiffgray -r200 -sOutputFile=" & XPATH & HENKAN & " " & XPATH & PDFMEI
　Set Result = WSH.exec("%ComSpec% /c " & cmd)

　Dim ChkCnt As Long
　Dim NgFlg As Boolean
　Const MaxTry = 5　'最大DoEvents数 1回/秒

　NgFlg = False
　ChkCnt = 0
　Do While Result.Status = 0
　　ChkCnt = ChkCnt + 1
　　DoEvents
　　If ChkCnt > MaxTry Then
　　　NgFlg = True
　　　Exit Do
　　End If
　　Call WaitFor(MaxTry)
　Loop
　'～～～～～～
end sub

'--指定した秒だけ停止---
Function WaitFor(ByVal second As Integer)
　Dim futureTime As Date
　futureTime = DateAdd("s", second, Now)
　While Now < futureTime
　　DoEvents
　Wend
End Function

回答No.1

unokwave

-sOutputFileで指定しているパスをDoEventsの前でファイルサイズをチェックして、タイムアウト時間待ってもサイズが変化しなければExit Doする条件分岐を書けば良い。

お礼

ありがとうございました。