Access (VBA)

Access VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows 10 Pro : Microsoft 365)
コマンドによって実行速度に大きな差が出る
投稿日時: 23/11/30 11:29:45
投稿者: tsusasu

おはようございます。
Accessで作成しているのでこちらに質問させていただきました。
 
コマンドプロンプトを起動して、
 
TaskList /V
 
を手動で実行したら10秒ぐらいですべての結果が表示(出力)されます。
※いま使っているPCです。
 
しかしながら同じコマンドをVBA経由で実行すると
 
Do Until libExec.Status: DoEvents: Loop
 
のループが延々と終わりません。
 
※手動実行だと10秒ぐらいで結果が出ましたが、VBA経由だと10分以上経っても終わらなかったです。
 途中で処理を止めましたが、結果が途中まで格納されていたので動いていてはいる様子・・・
 
VBA経由であっても
 
Dir [フォルダパス] /A /B /ON
 
上記コマンドはすぐに結果が返ってきましたが、
 
Dir [フォルダパス] /A /B /ON /S
 
のように「/S」スイッチ付けたら、TaskListと同様に結果が返ってきません。(超おそくなる)
 
超おそいコマンドについては、現在、strRet()に結果を返さないで、
 
TaskList /V >> [テキストファイルパス]
Dir [フォルダパス] /A /B /ON /S >> [テキストファイルパス]
 
のようにリダイレクトでテキストに出力&結果読込しています。
 
前置きが長くなりましたが、なぜこんなに実行速度に差がでるのでしょうか?
以下がコードになります。
 
よろしくお願いいたします。
 
 
事前バインディング(参照設定:Windows Script Host Object Model)してます。
 
Public Sub Test1()
 
    Dim strCmd As String
    Dim strRet() As String
    Dim intCnt As Integer
     
        '実行結果が出ない…超おそい…
        'strCmd = "TaskList /V"
        'strCmd = "Dir \\…\フォルダパス /A /B /ON /S"
         
        '普通に結果が返ってくる
        'strCmd = "Dir \\…\フォルダパス /A /B /ON "
        'strCmd = "CD"
         
        Call Test2(strCmd, strRet)
         
        For intCnt = LBound(strRet) To UBound(strRet)
            Debug.Print strRet(intCnt)
        Next
         
    MsgBox "End!"
     
End Sub
 
Private Sub Test2(strCmd As String, strRet() As String)
 
    Dim libWsh As New WshShell
    Dim libExec As WshExec
    Dim strBuffer As String
     
        '初期化
        Erase strRet()
         
        'コマンド実行後にウィンドウを閉じる
        Set libExec = libWsh.Exec("%ComSpec% /C " & strCmd)
         
        '処理完了まで待機
        Do Until libExec.Status: DoEvents: Loop
         
        '実行結果を取得して戻り値にセット
        With libExec
         
            strBuffer = .StdOut.ReadAll
             
            If Not strBuffer = "" Then
                strRet() = Split(strBuffer, vbCrLf)
            Else
                strRet() = Split(.StdErr.ReadAll, vbCrLf)
            End If
        End With
         
End Sub

回答
投稿日時: 23/11/30 13:48:23
投稿者: Suzu

引用:
前置きが長くなりましたが、なぜこんなに実行速度に差がでるのでしょうか?

 
それは、【DoEvents】を挟んでいるから。
 
そのコマンドは、OS に制御を一時的に渡すコマンドです。
 
コマンドプロンプトでは、占有的にそのコマンドを実行します。
 
対して、今回の処理は、コマンドラインの命令を渡し
終了したかどうかを判定し、終了していない時には、制御を一時的に OSに渡します。
 
コマンドプロンプトで
 
TaskList と TaskList /V
Dir   と Dir /S
 
それぞれ 実行してみましょう。
それだけでも、処理時間に 大きな差が生じているのが判ります。
 
その処理時間に 余計なループ処理、DoEvents が加わっています。
大きな差がでても なんら不思議と思いません。
 
プロセスが取得したいなら、
・Word の Tasks プロパティ
・WMIの Win32_Processクラス
 
フォルダのTree構造を得たいなら、
・FileSystemObject を使い、Folderオブジェクトに対し、subFolders コレクションの再起処理
 
を行えば良いでしょう。
 
コマンドライン結果をリダイレクトしテキストから取得する方法を採っておいて
「遅い」と言うのは お門違いと思ってしまいます。

投稿日時: 23/11/30 17:16:34
投稿者: tsusasu

Suzuさん
 
ご回答ありがとうございます。
Doevents関数を削除しても手動実行に近い時間では結果は戻りませんでした。
 
手動実行:10秒程度
Doevents削除:少なくとも5分以上(待てなくてキャンセル→途中までは配列に入っている)
 
プロセスやフォルダ構成を取得する手段としてコマンドプロンプトにこだわっている訳ではなく、
 
「なぜ手動実行とVBA実行でこれほど差がでるのか?」
 
の原因が知りたかっただけです。
 
なので「Doeventが原因では?」という回答はとてもありがたかったですが、
 
>>コマンドライン結果をリダイレクトしテキストから取得する方法を採っておいて
>>「遅い」と言うのは お門違いと思ってしまいます。
 
のように言われて(思われて)しまうのは心外でした。
 
質問者の立場ですし、場を荒らしたいわけではないので、
別の識者の方の回答を待たせていただければと思っております。
※原因不明、もしくは回答なしのようであればクローズします。
 
ご回答くださりありがとうございました。
 
 
 
当該原因についてご存じの方がいらっしゃいましたら、ぜひご教示くださいませ。
よろしくお願いいたします。

回答
投稿日時: 23/12/01 17:46:10
投稿者: Suzu

質問の意図が、単なる疑問からのご質問であり
中途半端な回答で誤解を招いたようですみません。
 
DoEvents だけが問題ではなく
それを、ループ処理 かつ 間に判定処理を入れていますので
それらが、遅くなる原因です。
 
 
何も判定せず、ループ処理 無し で
 
Sub TEST()
  Const strCmd As String = "TaskList /V"
  Dim libWsh As New WshShell
 
  libWsh.Exec "%ComSpec% /C " & strCmd
End Sub
 
の様な感じで、テストしてみましょう。

投稿日時: 23/12/04 10:10:31
投稿者: tsusasu

Suzuさま。
お世話になっております。
ご回答どうもありがとうございます。
 
ループを削除して下記を実行したところ、
手動実行と同じようなスピードで結果出力できました。
 
Doevents関数はもちろんのこと、
処理待ちループも実行を遅くする大きな原因だったことが分かり大変助かりました。
 
何か変な感じにしてしまい申し訳ありませんでした。
 
Option Compare Database
Option Explicit
 
Sub Test()
 
    Const strCmd As String = "TaskList /V"
     
        Dim libWsh As New WshShell
        Dim libExec As WshExec
     
            Set libExec = libWsh.Exec("%ComSpec% /C " & strCmd)
            Debug.Print libExec.StdOut.ReadAll
             
        Set libExec = Nothing
        Set libWsh = Nothing
         
End Sub
 
※15年(もっとかも)ぐらい前でしょうか…ここでは
 
 API関数などについては「Shira」さん
 テクニック系は「Yu-Tang」さん
 
に随分とお世話になりました。
 
他の質問に対する回答もとても参考(勉強)になっています。
引き続きよろしくお願いいたします。