'créer un nouveau fichier archive If Len(Dir(FichierZip)) > 0 Then Kill FichierZip 'supprime l'archive s'il existe déjà Open FichierZip For Output As #1 Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0) Close #1
'déplace le fichier à archiver dans l'archive Set ApplicationArchivage = CreateObject("Shell.Application") ApplicationArchivage.Namespace(FichierZip).MoveHere FichierAArchiver
il vous manque la réference "Microsoft Shell Controls And Automation". ? Mais difficile de diagnostiquer votre problème sans la déclaration de vos variables ni sans le code d'erreur....
J'ai essayé ce code (Excel malin) qui fonctionne parfaitement (y compris avec MoveHere au lieu de CopyHere:
Sub ArchiverUnFichier()
'par Excel-Malin.com ( https://excel-malin.com )
'---------------------------------------------------------
'gestion des erreurs
On Error GoTo ErreurCompression
'définition des variables
Dim ApplicationArchivage As Object
Dim FichierAArchiver, FichierZip
'informations sur les fichiers (chemins & noms)
FichierAArchiver = "C:\Test\MonFichierWord.docx"
FichierZip = "C:\Test\Archives\MonArchive_1.zip"
'créer un nouveau archive
If Len(Dir(FichierZip)) > 0 Then Kill FichierZip 'supprime l'archive s'il existe déjà
Open FichierZip For Output As #1
Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
Close #1
'copier le fichier à archiver dans l'archive
Set ApplicationArchivage = CreateObject("Shell.Application")
ApplicationArchivage.Namespace(FichierZip).CopyHere FichierAArchiver
'Message final
MsgBox "L'archivage a été lancé..."
Exit Sub
ErreurCompression:
MsgBox "Une erreur s'est produite..."
End Sub
Ce serait pas ta variable fichierZip qui comporte un caractère inapproprié pour un chemin? Essai avec C:\Temp\Essai.zip par exemple.
l'affichage ou non des extensions ne devrait pas influencer le chemin d'accès d'un fichier. ça me paraît bizarre.
Si pour une obscure raison c'est vraiment le cas, il faut voir s'il est possible de tester depuis le script l'état d'affichage des extensions et s'il est masqué, le basculer en visible le temps de son exécution.
J'ai trouvé l'origine du problème. Le VBA est trop rapide par rapport à Winzip. Les fichiers n'ont pas le temps de finir d'être zipper que déjà un autre arrive.
J'ai donc placé une messagebox avec oui/non pour que l'utilisateur donne le départ pour le fichier suivant.
Je pourrais aussi faire une condition de vérification.
Autrement solution faire une seul ligne de commande avec plusieur fichier mais je ne sais pas comment faire ( FichierAArchiverSTEP = le fichier .STEP )
J’ai créé d’autre variable FichierAArchiverDWG, FichierAArchiverDXF pour chaque fichier et chaque ligne l’envoie vers le ZIP
Merci pour ton lien. Dans cet exemple, il ZIP le dossier. Si je change le début de mon programme pour créer un dossier avec les DXF,DXG et STEP, cela peut fonctionner :)
Sub testing()
Dim ZipFile As String
Dim FolderToAdd As String
Dim objShell As Object
Dim varZipFile As Variant
ZipFile = "C:\ZipFile_Images\images.zip"
FolderToAdd = "C:\Images"
Set objShell = CreateObject("Shell.Application")
varZipFile = ZipFile
If Right$(FolderToAdd, 1) <> "\" Then
FolderToAdd = FolderToAdd & "\"
End If
objShell.NameSpace(varZipFile).CopyHere (FolderToAdd)
End Sub
