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 ?
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.
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 '//=========================================================================================================//
Voici la preuve que mon fichier a bien été créé ainsi que l'erreur qui me bloque en pièce jointe.
![]()
Partager