Script per comprimere un file

A volte in uno script amministrativo può essere necessario dover comprimere un file e in tal caso una possibilità è quella di usare le cartelle comprese presenti a partire da XP.

Option Explicit

Dim strScriptFullName, strCurrentPath, strZipFilePath, strAddFilePath

strScriptFullName = wscript.scriptfullname
strCurrentPath = Left(strscriptfullname, InStrRev(strScriptFullName, “\”))
strZipFilePath = strCurrentPath & “test.zip”
strAddFilePath = strCurrentPath & “test.txt”

‘Crea un file zip vuoto
If CreateEmptyZip(strZipFilePath) Then

  ‘Aggiunge un file all’archivio zip
  Call AddFile2Zip(strZipFilePath, strAddFilePath)

End If

Function CreateEmptyZip(strZipFilePath)
  On Error Resume Next

  ‘Apertura file in scrittura
  Dim objFso, objFile
  Const ForWriting = 2
  Set objFso = CreateObject(“Scripting.FileSystemObject”)
  Set objFile = objFso.OpenTextFile(strZipFilePath, ForWriting, True)

  If Err = 0 Then
    objFile.Write Chr(80) & Chr(75) & Chr(5) & Chr(6) & String(18, 0)
  End If

  If Err = 0 Then
    objFile.Close
  End If

  Set objFso = Nothing
  Set objFile = Nothing 

  If Err = 0 Then
    CreateEmptyZip=True
  Else
    Err.Clear
    CreateEmptyZip=False
  End If
End Function

Function AddFile2Zip(strZipFilePath, strAddFilePath)
  ‘On Error Resume Next

  Dim objApp, objFolder
  Set objApp = createobject(“Shell.Application”)
  Set objFolder = objApp.NameSpace(strZipFilePath)

  If Err = 0 Then
    Call objFolder.CopyHere(strAddFilePath)

    ‘Le opzioni di CopyHere sembrano non avere effetto
    ‘per operazioni su cartelle compresse

    ‘Pausa per consentire l’avvio del processo di compressione
    ‘in quanto il processo verrà avviato quando quando il
    ‘processo dello script verrà messo in idle se il
    ‘processo dello script termina prima il processo
    ‘di compressione non viene avviato.
    ‘Ciò accade perchè CopyHere è asincrona
     wscript.Sleep 500
  End If

  Set objFolder = Nothing
  Set objApp = Nothing

  If Err = 0 Then
    AddFile2Zip = True
  Else
    Err.Clear
    AddFile2Zip = False
  End If
End Function