Bonjour à tous, j'essaie de programmer une fonction de compression de fichier excel dans une archive dont le chemin est ici "CheminZIP". Le probleme étant qu'à l'exécution, la fonction bloque sur la création de l'objet. En effet, la ligne "Set objZip = objShell.Namespace(CheminZIP)" ne semble pas fonctionner correctement et ne renvoie rien, je me retrouve au final avec objZIP = Nothing... Pourtant le fichier d'Archive .ZIP a bien été créé à chaque fois mais puisque l'objet est vide, je ne peux pas ajouter mes fichier à l'intérieur. Sauriez-vous m'aider à y voir plus clair ?
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
'//=========================================================================================================//
'Fonction qui permet de Zip un fichier et de le renvoyer
Function ZipFiles(ByVal Fichier1 As String, ByVal Fichier2 As String, ByVal Fichier3 As String) As String
    Dim objShell As Object, objZip As Object
    Dim CheminZIP As String
    Dim ListeFichier As Variant
    
    ' --- Liste des fichiers à inclure ---
    ListeFichier = Array(Fichier1, Fichier2, Fichier3)
    
    ' --- Définir le chemin du ZIP final ---
    CheminZIP = "C:\Temp\ArchiveDebug_MacroControle_" & Format(Now, "yyyymmdd_hhmmss") & ".zip"
    
    
    ' --- Créer un ZIP vide si inexistant ---
    If Dir(CheminZIP) = "" Then
        Open CheminZIP For Output As #1
        Print #1, "PK" & Chr$(5) & Chr$(6) & String$(18, vbNullChar)
        Close #1
    End If
    
    ' --- Préparer l'objet Shell ---
    Set objShell = CreateObject("Shell.Application")
    Set objZip = objShell.Namespace(CheminZIP)
    
    ' --- Ajouter les fichiers un par un ---
    For Each Fichier In ListeFichier
        If Dir(Fichier) <> "" Then ' vérifier si le fichier existe
            objZip.CopyHere Fichier
            ' pause pour laisser Windows compresser avant d'ajouter le suivant
            Application.Wait Now + TimeValue("0:00:02")
        End If
    Next Fichier
    
    MsgBox ("Fichiers trop lourds ! Compression et création d'un fichier .ZIP terminée.")
    
    ZipFiles = CheminZIP
    
End Function
'//=========================================================================================================//
En entrée de ma fonction, trois chemins de fichiers .xlsm que je veux compresser et ajouter à l'archive ZIP. En sortie, le chemin du fichier ZIP pour que je puisse transférer l'archive plus tard par mail.
Voici la preuve que mon fichier a bien été créé ainsi que l'erreur qui me bloque en pièce jointe.
Nom : 1.PNG
Affichages : 78
Taille : 16,0 Ko
Nom : 2.png
Affichages : 75
Taille : 7,4 Ko