0

USB ユーティリティ ディスクの作成の一環として、一連のファイルを USB スティックにコピーする HTA があります。正常に動作しますが、問題は、コピー プロセスの実行中に HTA が応答しなくなることです。

Const FOF_CREATEPROGRESSDLG = &H0&
sub CopyFiles(driveletter) ' Copys Files to the new USB Disk showing progress bar 

  if radio(0).checked Then 
    Set objFilesys = CreateObject("Scripting.FileSystemObject")
    Set objShell = CreateObject("Shell.Application")
    driveletter = ((driveletter) & "\")
    Set objFolder = objshell.NameSpace(driveletter)
    pathstring = objFilesys.GetAbsolutePathName("c:") 
    objFolder.CopyHere pathstring & "\" & "*.*", FOF_CREATEPROGRESSDLG
    exit sub
  elseif radio(1).checked Then
    Set objFilesys = CreateObject("Scripting.FileSystemObject")
            set objShell = CreateObject("shell.application")
    pathstring = userselections.txtFile.value   
        if objFilesys.fileExists(pathstring & "\" & "kernel.sys") then
            driveletter = ((driveletter) & "\")
            Set objFolder = objshell.NameSpace(driveletter) 
                    objFolder.CopyHere pathstring & "\" & "*.*", FOF_CREATEPROGRESSDLG
        Else
            msgbox "Error! The Specified path does not contain valid Install Files", vbcritical 
        end if
  end if 
end sub 
4

1 に答える 1

0

あなたの問題は、shell.application の CopyHere メソッドが非同期であることです。コピー中に実行を一時停止しません。

「objFolder.CopyHere」が開始され、その直後に「Exit Sub」が呼び出されるため、CopyHere が完了する前にコードが制御を失います。

CopyHere を同期型にする例がいくつかあります。

これは zip で機能するものですが、ニーズに合わせて調整できます。

于 2012-09-13T02:13:58.767 に答える