Auteur Topic: vba code zip map (gelezen 644 keer)

AD1957 · « **Gepost op:** 16 maart 2022, 10:39:24 »

Beste helpers,

Met onderstaande code probeer ik een bestandenmap te zippen.
Krijg echter steeds de foutmelding: Fout 9 Objectvariabele of blokvariabele with is niet ingesteld.
op de regel: ShellApp.Namespace(zippedFileFullName).CopyHere ShellApp.Namespace(folderToZipPath).items

Code: [Selecteer]

Sub test1()
Dim source, zipfile As String
source = "C:\Users\" & Environ("username") & "\Desktop\ZIPMAP\"
  zipfile = Environ("TEMP") & "\ONDERHOUD_CV.zip"
CreateZipFile source, zipfile
End Sub

Sub CreateZipFile(folderToZipPath As Variant, zippedFileFullName As Variant)
Dim ShellApp As Object

'Create an empty zip file
Open zippedFileFullName For Output As #1
Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
Close #1

'Copy the files & folders into the zip file

Set ShellApp = CreateObject("Shell.Application")

ShellApp.Namespace(zippedFileFullName).CopyHere ShellApp.Namespace(folderToZipPath).items

Do Until ShellApp.Namespace(zippedFileFullName).items.Count = ShellApp.Namespace(folderToZipPath).items.Count
     Application.Wait (Now + TimeValue("0:00:01"))
Loop
End Sub

Heeft iemand een oplossing ?

Montagnard · « **Reactie #1 Gepost op:** 17 maart 2022, 10:18:58 »

dag,
ikzelf ken er niet genoeg van maar dit heb ik gevonden , misschien kan je hiermee weg :
https://exceloffthegrid.com/vba-cod-to-zip-unzip/
https://www.rondebruin.nl/win/s7/win001.htm

nog wat code :

Code: [Selecteer]

Sub CreateZipFile()
Dim folderToZipPath As Variant, zippedFileFullName As Variant
folderToZipPath = "C:\Photo"
zippedFileFullName = "C:\Users\June\Test.zip"
Dim ShellApp As Object
'Create an empty zip file
Open zippedFileFullName For Output As #1
Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
Close #1
'Copy the files & folders into the zip file
Set ShellApp = CreateObject("Shell.Application")
'ShellApp.Namespace(zippedFileFullName).CopyHere ShellApp.Namespace(folderToZipPath).Items 'copies only items within folder
ShellApp.Namespace(zippedFileFullName).CopyHere folderToZipPath 'copies folder and its contents

Mvg,
Arnold.

AD1957 · « **Reactie #2 Gepost op:** 17 maart 2022, 11:02:19 »

Hoi Montagnard,

De code op de site van exceloffthegrid.com heb ik vanmorgen (heel vroeg) toegepast.
En deze werkt prima.

Code: [Selecteer]

Sub test2()
Call CreateZipFile("C:\Users\" & Environ("username") & "\Desktop\ZIPMAP\", Environ("TEMP") & "\ONDERHOUD_CV.zip")
End Sub


Sub CreateZipFile(folderToZipPath As Variant, zippedFileFullName As Variant)

Dim ShellApp As Object

'Create an empty zip file
Open zippedFileFullName For Output As #1
Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
Close #1

'Copy the files & folders into the zip file
Set ShellApp = CreateObject("Shell.Application")
ShellApp.Namespace(zippedFileFullName).CopyHere ShellApp.Namespace(folderToZipPath).items

'Zipping the files may take a while, create loop to pause the macro until zipping has finished.
On Error Resume Next
Do Until ShellApp.Namespace(zippedFileFullName).items.Count = ShellApp.Namespace(folderToZipPath).items.Count
    Application.Wait (Now + TimeValue("0:00:01"))
Loop
On Error GoTo 0
End Sub

Toch nog bedankt voor de moeite.

Help!

Menu

Hulp bij posten

Zoeken

Recente topics

Auteur Topic: vba code zip map (gelezen 644 keer)

AD1957

vba code zip map

Montagnard

Re: vba code zip map

AD1957

Re: vba code zip map