Visual Basic 6 - Aiuto per copiare un'intera cartella in un file zip

Ciao a tutti sono nuovo e chiedo un po d'aiuto in quanto ho dei problemini, arrivo subito al dunque...

Io sto creando un programma di backupaggio... e ho la necessità di far creare un fil zip vuoto nella cartella selezionata e di conseguenza far copiare la cartella selezionata nel archivio zip...

Il tutto è composto cosi.... txtDirectory si riferisce alla cartella selezionata per il backupaggio, txtDirectory2 si riferisce alla directory di salvataggio del file zip... quando premo il tasto "salva"

Private Sub Salva_Click()
strDate = Format(Now, " dd-mmm-yy h-mm-ss"
FileNameZip = DefPath & "MyFilesZip " & strDate & ".zip"

Set oApp = CreateObject("Shell.Application"

'Create empty Zip File
NewZip (FileNameZip)
FolderName = txtDirectory
If Right(FolderName, 1) <> "\" Then
FolderName = FolderName & "\"
End If

'Copy the files to the compressed folder
CopyFile FolderName, FileNameZip, 0
End Sub

In un modulo ho scritto il sub per la creazione del zip:

Sub NewZip(sPath)
On Error Resume Next
If Len(Dir(sPath)) > 0 Then Kill sPath
Open sPath For Output As #1
Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
Close #1
End Sub

e per copiare i file ho dichiarato il CopyFile:
Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long

Nulla mi da errori ma nel momento di salvataggio mi crea il file zip ma non mi copia i file al suo interno.... cercando su internet ho trovato quest'altro metodo:

oApp.Namespace(FileNameZip).CopyHere oApp.Namespace(FolderName).items

che però non riesco a far funzionare... nonostante oApp è dichiarato come Object e settato come: ("shell.aplication" mi dice che c'è errore sul blocco with... allora lo imposto cosi:

with object
oApp.Namespace(FileNameZip).CopyHere oApp.Namespace(FolderName).items
End with

però mi da ancora errore... non so più dove sbattere la testa, se gentilmente qualcuno mi da un'aiutino gli sarei mooolto grato

Fammi capire da dove hai preso quell'assurdo codice per creare un file zip ...

Ci credo che non funziona ...

anch'io stavo facendo un programma di back up e anche io avevo questo problema ma dopo una ricerca su google ho risolto
Guarda qui:
In un modulo:

'''''''''''''''''''''''''''''''''''OPZIONI_ZIP''''''''''''''''''''''''''''''''''''''''''''
'[variabili]
Public strScriptFullName, strCurrentPath, strZipFilePath, strAddFilePath

'[Crea un file zip vuoto]
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
'[Aggiunge un file al file zip]
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

Ecco i due comandi, uno per creare lo zip e uno per aggiungergli dei file:

CreateEmptyZip "C:\percorso\file.zip" 'Crea lo zip
Call AddFile2Zip("C:\percorsodovestalozip\file.zip, "C:\percorso dei file o della cartella da ggiungergli") 'aggiunge file/cartelle allo zip

Cosi' va meglio ... e per non usare l'oggetto FileSystemObject la creazione dello zip vuoto la scriverei cosi'

Private Type zipHeader
    hd As Long
    zh As String * 18
End Type

Function CreateZip(ByVal strZipFilePath As String)
    On Error Resume Next
    Dim fh As Integer
    Dim h As zipHeader
    
    h.hd = &H6054B50
    
    fh = FreeFile
    Open strZipFilePath For Binary As fh
    Put #fh, , h
    Close #fh
    
    CreateZip = (Err = 0)
    Err.Clear
End Function

Quell'assurdo codice funziona intanto xD e l'errore non risiede in quella parte del codice.. comunque.... fatto sta che se anche rifaccio il tutto come dite voi... non mi da errori... però all'apertura dell'archivio zip non trovo nulla... se non sbaglio è per il fatto che il processo di copia verrà effettuato quando lo script sarà in idle... come faccio a non "aspettare"???

E chi ha detto che non funziona ... ma resta assurdo perche' non fa altro che scrivere un header in modo costante, senza considerare il fatto che questo header potrebbe cambiare nelle nuove versioni di file ZIP ...



Ho provato e funziona regolarmente ...

Anche a me funziona.

Ragazzi... non per cosa... ma io ho fatto copia ed in colla in un modulo e richiamati con il comando "call" esempio "call AddFile2Zip(FileNameZip, FolderName)" com'è giusto che sia... alla prova del 9 mi da "variabile oggetto o variabile del blocco with non impostata"

ora come io sto impazzendo... perchè ho provato di tutto non è che mi potreste allegare il vostro progetto in cui va in modo tale da vedere che diavolo sbaglio???