Jeans & Development コンピューターのことなどを綴ったメモ (旧：目から鱗 w/SQLite)

option explicit
Dim files(0)
files(0)=".\test.txt"
Call MakeZip(".\temp.zip",files)

Sub MakeZip(ByVal ZipPath, ByRef FileArray)
  Dim sfo,app,file,num
  Set sfo=CreateObject("Scripting.FileSystemObject")
  Set app = CreateObject("Shell.Application")
  ZipPath=sfo.GetAbsolutePathName(ZipPath)

  'Create empty zip file
  Dim arrHex, sBin, i
  arrHex = Array(80,75,5,6,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0)
  For i = 0 To UBound(arrHex)
    sBin = sBin + Chr(arrHex(i))
  Next
  With sfo.CreateTextFile(ZipPath, True)
      .Write sBin
      .Close
  End With
  
  'Copy the file(s) into the zip file
  num=0
  For Each file In FileArray
    If CStr(file)<>"" Then
      file=sfo.GetAbsolutePathName(file)
      app.Namespace(ZipPath).CopyHere(file)
      num=num+1
      'Wait until "CopyHere" command is done
      Do Until app.Namespace(ZipPath).items.Count=num
        WScript.sleep 1
      Loop
    End If
  Next

End Sub