[vba] zippare cartella

[john_revelator]

Buona sera a tutti. Avrei necessità all'interno di un mio script di zippare il contenuto di una cartella. Cercando in rete ho trovato una discussione su experts-exchange.
La discussione è raggiungibile digitando su google

VBA or VBS to Zip files in a folder - Win XP , Using Access (VBA Code)

e andando sul link copia cache.
Purtroppo mi appare il messaggio che il file zip è stato creato ma invece non è presente. Ovviamente ho creato la cartella di prova contenente alcuni file e il percorso è esatto. Spero che qualcuno possa aiutarmi.
Grazie e buona notte. :)

Posto il codice intero


Sub Zip_Folder_And_SubFolders()
Dim PathWinZip As String, FileNameZip As String, FolderName As String
Dim ShellStr As String, strDate As String, DefPath As String

PathWinZip = "C:\programmi\winzip\"
If Dir(PathWinZip & "winzip32.exe") = "" Then
MsgBox "Winzip non è stato trovato"
Exit Sub
End If


FileNameZip = "C:\Documents and Settings\utente\desktop\test.zip"

FolderName = "C:\Documents and Settings\utente\desktop\miacart\"

If Right(FolderName, 1) <> "\" Then
FolderName = FolderName & "\"
End If

ShellStr = PathWinZip & "Winzip32 -min -a -r -p" _
& " " & Chr(34) & FileNameZip & Chr(34) _
& " " & Chr(34) & FolderName & Chr(34)
ShellAndWait ShellStr

MsgBox "Il file zip è pronto in: " & FileNameZip
End Sub


Public Sub ShellAndWait(PathName As String)
Dim TaskID As Double
TaskID = Shell(PathName, vbHide) ', vbNormalFocus)
While TaskExists(TaskID)
Wend
End Sub


Public Function TaskExists(TaskID As Double) As Boolean
On Error GoTo ErrorHandler
AppActivate (TaskID)
ErrorHandler: If Err.Number = 5 Then
TaskExists = False
Exit Function
Else
TaskExists = True
End If
End Function

[john_revelator]

:help:

[MarcoGG]

...
ShellStr = PathWinZip & "Winzip32 -min -a -r -p" _
...
Public Sub ShellAndWait(PathName As String)
Dim TaskID As Double
TaskID = Shell(PathName, vbHide) ', vbNormalFocus)
While TaskExists(TaskID)
Wend
End Sub

Public Function TaskExists(TaskID As Double) As Boolean
On Error GoTo ErrorHandler
AppActivate (TaskID)
ErrorHandler: If Err.Number = 5 Then
TaskExists = False
Exit Function
Else
TaskExists = True
End If
End Function


Da una veloce occhiata a quel codice vedo almeno 3 cose che non mi piacciono per niente :

1. Il parametro -p dato in pasto alla strShell include tutto il percorso, e quindi tutta la struttura di eventuali cartelle di livello superiore a quella che si sta per zippare vengono incluse nello zip. Meglio evitare di metterlo. ;)

2. Nella Public Sub ShellAndWait c'è un orrendo While / Wend senza istruzioni al suo interno. A che può servire ?

3. L'error handler in Public Function TaskExists è probabilmente la causa del fatto che poi il messaggino ti dice Ok, ma non ti ritrovi lo zip ! Semplicemente quel codice va in errore per qualche motivo ( e non mi stupisce la cosa ), e quell'error handler, scritto così, evita che il programma vada in errore, ma non esegue nulla in merito...

Se sei interessato devo avere una cosa simile modificata ( nel senso che me la ero modificata IO :D ) da qualche parte... E la mia funziona.