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.
[Update] Si tenga conto che Le cartelle compresse di XP hanno il limite di 4 GB
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