VBScript ZIP圧縮ロジック

Option Explicit

Dim Fso
Dim Shell
Dim folder
Dim file
Dim DateNow
Dim ZipFileName
Dim ZipFilePath
Dim fldrName
Dim fileCount
Dim EmptyData
Dim ZipFolder
Dim CompressItem
Dim Date400
Dim i

'オブジェクト作成
Set Fso = CreateObject("Scripting.FileSystemObject")
Set Shell = CreateObject("Shell.Application")

'引数カウントチェック
If WScript.Arguments.Count() < 1 Then
    WScript.Echo "引数が足りてません。"
    WScript.Quit(4)
End If
fldrName = WScript.Arguments.Item(0)

'ZIPファイル名を取得
DateNow = Now()
ZipFileName = Year(DateNow) & Right("0" & Month(DateNow), 2) & Right("0" & Day(DateNow), 2) & ".zip"
ZipFilePath = fldrName & "\" & ZipFileName
WScript.Echo "Zipファイル名：" & ZipFilePath

'ファイル数確認
set folder = fso.getFolder(fldrName)
fileCount = 0
for each file in folder.files
    if fso.GetExtensionName(file.name) <> "zip" then
        fileCount = fileCount + 1
    End if
next

'ファイル数が0件の場合は、処理終了
if fileCount = 0 then
    WScript.Echo "対象ファイルがありません。"
    WScript.Quit(4)
End if

'同名のZipファイルがある場合は削除
if fso.FileExists(ZipFilePath) then
    Fso.DeleteFile ZipFilePath, True
End if

'空のZIPファイルを作成&識別子を書込
EmptyData = Chr(&H50) & Chr(&H4B) & Chr(&H5) & Chr(&H6) & String(18,Chr(0))
Fso.CreateTextFile(ZipFilePath,False).Write EmptyData

'ZIPファイルの絶対パスを取得
Set ZipFolder = Shell.NameSpace(fso.GetAbsolutePathName(ZipFilePath))

for each file in folder.files
    if fso.GetExtensionName(file.name) <> "zip" then
        CompressItem = fso.GetAbsolutePathName(file)

        'Zipファイルへ追加
        ZipFolder.CopyHere(CompressItem)
        'Zipファイルの排他制御チェックを行う。(排他中はループ処理を継続)
        Do Until chkFileLock(ZipFilePath):Loop
        '対象ファイルの削除
        fso.DeleteFile CompressItem
    End if
next

Set Fso = Nothing
Set Shell = Nothing

WScript.Quit

'==================================================
' Function : 排他制御チェック
'==================================================
Private Function chkFileLock(getObj)
    On Error Resume Next
    Dim iomode
    iomode=8 'Appendingモード
 
    WScript.Sleep 1000

    'ファイルを追記モードで開閉
    'set SetFileObj = Fso.OpenTextFile(getObj,iomode,False).Close
    'SetFileObj.Close
    Fso.OpenTextFile(getObj,iomode,False).Close
 
    '排他制御状態の場合はエラー
    if Err.Number = 0 then
        chkFileLock = True
    end if
 
End Function

【参考サイト】
marazul2015.blog.fc2.com