Een nieuw archiefbestand maken Als Len(Dir(ZipFile)) > 0, dan verwijdert Kill ZipFile' het archief als het al bestaat Open FileZip voor uitvoer als #1 Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & Tekenreeks(18, 0) Sluiten #1
'Verplaatst het te archiveren bestand naar het archief Set ApplicationArchiving = CreateObject("Shell.Application") ApplicationArchive.Namespace(ZipFile). MoveHere FileAArchiver
u mist de referentie "Microsoft Shell Controls And Automation". ? Maar het is moeilijk om uw probleem te diagnosticeren zonder uw variabelen te verklaren of zonder de foutcode....
Ik heb deze code geprobeerd (slimme Excel) die perfect werkt (ook met MoveHere in plaats van 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
Zou het niet uw variabele ZipFile zijn die een ongepast karakter heeft voor een pad? Probeer het bijvoorbeeld met C:\Temp\Essai.zip.
Het al dan niet weergeven van extensies mag geen invloed hebben op het pad van een bestand. Het komt me vreemd voor.
Als dit om de een of andere duistere reden echt het geval is, moet je kijken of het mogelijk is om de weergavestatus van de extensies uit het script te testen en als het verborgen is, schakel het dan over naar zichtbaar voor de tijd dat het wordt uitgevoerd.
Ik heb de oorzaak van het probleem gevonden. De VBA is te snel in vergelijking met Winzip. De bestanden hebben geen tijd om klaar te zijn met zippen voordat er een andere arriveert.
Dus heb ik een berichtbox geplaatst met ja/nee zodat de gebruiker de start geeft voor het volgende bestand.
Ik zou ook een verificatievoorwaarde kunnen stellen.
Anders oplossing maak een enkele opdrachtregel met meerdere bestanden, maar ik weet niet hoe ik het moet doen ( FileAArchiverSTEP = het bestand . RWZI )
Ik heb een andere variabele gemaakt, FileAArchiverDWG, FileAArchiverDXF voor elk bestand en elke regel stuurt het naar de ZIP
Dank u voor uw link. In dit voorbeeld wordt de map gezipt. Als ik het begin van mijn programma verander om een map te maken met de DXF, DXG en STEP, kan het werken:)
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
