Win7・Win2008環境にて、Windowsバッチ(.bat)から、
引数に対象フォルダ・ZIPファイル作成場所を受け取って
フォルダのZIP化を行うVBSスクリプトを作成しています。
下記のスクリプトをsample.vbsで作成しsample.batから実行すると
ファイルがZIPファイル内に格納されておりません。(空のZIPファイル)
そのため、「★★★」箇所の排他処理の関数を呼び出すようにすると
ファイルがZIPファイル内に格納されるようになりましたが、
処理がいつまでも完了しません。
(コマンドプロンプトから直接コマンドライン実行すると正常終了します。)
何か間違ってますでしょうか？(そもそもフォルダのZIP化手順も含め)
ご教授ほどよろしくお願い致します。
■sample.vbs ※okwave用インデントのために全角スペース使用
' *******************************************************
' オブジェクト定義
' *******************************************************
Dim fso
Dim subf
Dim FileName ' ファイル名
Dim ArgDam ' 遡り日数
Dim DifDam ' 遡り日数との差
Dim FDate ' ファイル作成日
Dim strTargetFolder ' ZIPファイル作成フォルダ
Dim m_objShell
Set m_objShell = CreateObject("Shell.Application")
Set fso = CreateObject("Scripting.FileSystemObject")
intOutRet = 0
' 引数の取得*********************************************
' 引数/ZIP化対象フォルダ情報を取得
Set subf = fso.GetFolder(WScript.Arguments(0))
' 引数/ZIPファイルの情報を取得
strTargetFolder = WScript.Arguments(1)
' ZIP化処理**********************************************
If CreateZipfile(subf, strTargetFolder) = false Then
intOutRet = 1
End If
' オブジェクト開放
Set fso = Nothing
WScript.Quit intOutRet
' ZIPファイルの作成**************************************
Private Function CreateZipfile(subf, strTargetFolder)
Dim intFileCnt
Dim idx
On Error Resume Next
intFileCnt = 0
For Each FileName In subf.Files
intFileCnt = intFileCnt + 1
Next
'intFileCnt = intFileCnt - 1
idx = 0
Dim intNumbers() '動的配列を宣言
ReDim intNumbers(intFileCnt)
For Each FileName In subf.Files
intNumbers(idx) = FileName
idx = idx + 1
Next
'書庫ファイル作成
fso.CreateTextFile(strTargetFolder, False).Write "PK" & Chr(5) & Chr(6) & String(18, 0)
'書庫オブジェクト取得
Set l_objZIP = m_objShell.NameSpace(CStr(strTargetFolder))
'圧縮対象ファイルを取得
For Each l_strItem In intNumbers
'書庫に追加
l_objZIP.CopyHere l_strItem
'書庫が排他状態で開けるまで、処理継続・・・・・・・・★★★
Do Until IsNoOpen(l_strItem)
Loop
Next
' 正常終了
CreateZipfile = True
exit function
On Error Goto 0
' 異常終了
CreateZipfile = false
End Function
'排他チェック********************************************
Private Function IsNoOpen(p_strFileName)
'エラー無視
On Error Resume Next
WScript.Sleep 100
'ファイルを追加モードで開く/閉じる
Call fso.OpenTextFile(p_strFileName, 8, false).Close
IsNoOpen = CBool((Err.Number = 0))
End Function
■sample.bat
F:\BAT\sample.vbs "F:\LOG" "F:\LOG\sample.zip"
exit
