Vista用にファイルをZip形式に自動圧縮するVBScriptを記述しました。
しかし、ソースコードに待ち時間"WScript.Sleep(500)"を挿入しないとなぜか圧縮に失敗します。
待ち時間を設定することで圧縮に失敗する現象が起こりにくくなりますが、動作が完全に安定させることができません。意味無く待ち時間を長くするのは問題ですし、かといって適切な待ち時間を決める合理的根拠も見つかりません。できれば待ち時間以外の方法で確実に処理する方法を採用したい。
質問1 上記の現象が起こる原因は？
質問2 より適切な回避策(待ち時間を設定しなくても確実に処理する方法)はありますか？
以下のソースコードはVisual Basicでは無くVBScriptです
option explicit
' ********************************************
' ファイルを自動圧縮するVBScript
' *********************************************
' 宣言
Dim ID
Dim inpFolder
Dim outFolder
' フォルダー名とファイル名を定義します。
' 保存対象や保存先を変更する時は下の4行を修正します
ID = "XXXXX"
inpFolder = "c:\temp1\"
outFolder = "c:\temp2\"
CreateFolder outFolder
CreateZip (inpFolder & "a_" & ID & ".nsf") , (outFolder & "a_" & ID & ".zip")
CreateZip (inpFolder & "l_" & ID & ".nsf") , (outFolder & "l_" & ID & ".zip")
Stop
' フォルダーが無ければ作成します
Sub CreateFolder(source)
Dim fso
Set fso = WScript.CreateObject("Scripting.FileSystemObject")
If Fso.FolderExists(source) = False Then
fso.CreateFolder(source)
End If
End Sub
' zipファイルを作成します。
Sub CreateZip(source , target)
Dim fso
Dim sa
' 空のファイルを作成します。
Set fso = CreateObject("Scripting.FileSystemObject")
With fso.CreateTextFile(target)
.Write "PK" & Chr(5) & Chr(6) & String(18,0)
.Close
End With
' 圧縮データを書き込みます。
Set sa = CreateObject("Shell.Application")
With sa.NameSpace(target)
.CopyHere source
' 下のWscript.Sleep(500)をコメントアウトすると圧縮が失敗する
WScript.Sleep(500)
End With
End Sub
http://okwave.jp/qa/q2006207.html
以前に載せたサンプルを利用されたのだと思いますが、私もあの時初めて利用したので、よくわからずに載せました。
あれから少しShellを少し覚え、自身で他の用途で利用しております。
0.5秒だからいいのではなく、PCの処理能力的と圧縮元のファイルサイズからに0.5秒だと、たまたまうまくいっただけだと思います。
CopyHere()を発行する前に、書庫内のファイル数を取得して、ファイルが書庫に追加されるまで待機するという処理が、本来求められるものだと思います。
' 圧縮データを書き込みます。
Set sa = CreateObject("Shell.Application")
With sa.NameSpace(target)
Dim l_intCount
l_intCount = .Items().Count
.CopyHere source
Do Until (l_intCount < .Items().Count)
WScript.Sleep(1)
Loop
End With
お礼
ご回答ありがとうございます。 ファイル数をカウントすることで適切な同期がとれることが確認できました。 おかげで解決できました。感謝します。