Bonjour,

J'utilise le code de la FAQ https://excel.developpez.com/sources...#ZipperDossier

Le code fonctionne sur ACCES mais j'ai l'erreur suivante quand j'ai un sous-dossier vide.
Windows n'a pas pu ajouter un ou plusieurs répertoires vides dans le dossier compressé (zippé)

Ne pouvant maitriser si les dossiers seront vide, voyez-vous une solution pour éviter ce message d'erreur ?

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
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
 
Sub ZipRepertoire()
    '
    'Source
    'http://www.codecomments.com/archive299-2006-2-295877.html
    '
    Const ForReading = 1, ForWriting = 2, ForAppending = 8
 
    Dim Source, Destination, MyHex, MyBinary, i
    Dim oShell, oApp, oFolder, oCTF, oFile
    Dim oFileSys
 
    'Spécifiez le répertoire
    Source = "C:\Le répertoire"
    Destination = "C:\maSauvegarde.zip"
 
    MyHex = _
    Array(80, 75, 5, 6, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)
 
    For i = 0 To UBound(MyHex)
        MyBinary = MyBinary & Chr(MyHex(i))
    Next
 
    Set oShell = CreateObject("WScript.Shell")
    Set oFileSys = CreateObject("Scripting.FileSystemObject")
 
    'Création de la base du fichier zip.
    Set oCTF = oFileSys.CreateTextFile(Destination, True)
    oCTF.Write MyBinary
    oCTF.Close
    Set oCTF = Nothing
 
    Set oApp = CreateObject("Shell.Application")
 
    Set oFolder = oApp.Namespace(Source)
    If Not oFolder Is Nothing Then _
        oApp.Namespace(Destination).CopyHere oFolder.Items
 
    Set oFile = Nothing
    On Error Resume Next
 
    Do While (oFile Is Nothing)
        'Attention: provoque une erreur 70 si un des fichiers à zipper
        'est toujours ouvert.
        Set oFile = oFileSys.OpenTextFile(Destination, ForAppending, False)
 
        If Err.Number <> 0 Then
            Err.Clear
        End If
    Loop
 
    Set oFile = Nothing
    Set oFileSys = Nothing
End Sub
D'avance merci pour votre aide