Bonjour à tous,

J'essai de copier des fichiers dans une archive zip. J'ai trouvé des bouts de code sur le net que j'ai assemblé et tout fonctionne bien sauf qu'à la fin mon archive est vide.
Avez vous une idée de ce qu'il pourrait ce passer ?

Merci d'avance.

Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
'Ensuite on va créer l'archive avec le nom CurrentFile
Dim FSO As Object
Dim f As Object
Dim nbFile As Integer
 
Set FSO = CreateObject("Scripting.FileSystemObject")
 
For Each Cell In wsData.Range("A2:A" & wsData.Range("A65535").End(xlUp).Row)
    For Each f In FSO.GetFolder(wsParam.Range("B1")).Files
      If f.Name Like "*" & Cell.Value & "*" Then
        If Len(Dir(CurrentFile)) = 0 Then
            Call NewZip(CurrentFile)
        End If
        Call CopierFichierDansArchiveExistant(f, CurrentFile)
      End If
    Next f
Next Cell
 
Sub CopierFichierDansArchiveExistant(ByVal FichierAArchiver As Variant, ByVal FichierZip As Variant)
 
'définition des variables
    Dim ApplicationArchivage As Object
 
'copier le fichier à archiver dans l'archive
    Set ApplicationArchivage = CreateObject("Shell.Application")
    ApplicationArchivage.Namespace(FichierZip).CopyHere FichierAArchiver
 
End Sub
 
Sub NewZip(ByVal sPath As String)
'Create empty Zip File
    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