Zipping a group of files within Excel VBA

[Roncondor]

I looked at ww.mrexcel.com/board/threads/zip-series-of-files-with-same-prefix-in-the-same-folder.1154257/

But when I tried to clean up and customize, it does not work for me.

I am trying to zip a group of files within in a directory e,g,, every file that has "*XYZ*.* in directory C:\port\abc

This group is amazing as I always get great responses. Hopefully someone can help me out here

Code is below

THANK YOU! THANK YOU!

Ron

**********************************

Sub Zip_File_Groups()

Dim Sh As Object

Dim FiletoAdd As String

Dim FilePath As String
Dim FilePathSlash As String

Dim ZipFile As String
Dim ZipFileWithPath As String

Dim ShZipFolder As Object
Dim ShFolderItem As Object

'=====================================
' Name FilePath and zip file name
'=====================================
FilePath = "c:\port\ABC"
FilePathSlash = FilePath & "\"

ZipFile = "TEST.ZIP"
ZipFileWithPath = FilePathwithslash + ZipFile

'=================
' Create zip File
'================
Open ZipFileWithPath For Output As #1
Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
Close #1

'=================================
' Loop through the files desired
'=================================

FiletoAdd = Dir(FilePathSlash & "*XYZ*.*")

While FiletoAdd <> vbNullString

Set Sh = CreateObject("Shell.Application")

With Sh

Set ShZipFolder = .Namespace(ZipFileWithPath)

'======================================
'THIS IS THE PROBLEM LINE THAT BLOWS UP and gives me
' "object Variable or with block variable not set"
'========================================
Set ShFolderItem = .Namespace(FilePath).Items().Item(ZipFileWithPath) ' <--- THIS IS THE LINE THAT BLOWS UP
'======================================

ShZipFolder.MoveHere ShFolderItem

DoEvents

End With

FiletoAdd = Dir

Wend

End Sub[/CODE]

 

[rollis13]

Haven't tested your macro but I think that you have (at least here) a typo in this line:
ZipFileWithPath = FilePathwithslash + ZipFile
the variable FilePathwithslash has never been valued in all the macro.
Why don't you use Option Explicit ? this would've detected the typo.

 

[Roncondor]

Thanks- I do use option explicit - In the code I listed here it is not defined - but I had previously changed it in my macro but neglected to update the code in the posting

The revised code is below
=================

Option Explicit

Sub Zip_File_Groups()

    Dim Sh              As Object
   
    Dim FiletoAdd       As String
   
    Dim FilePath        As String
    Dim FilePathSlash   As String
   
    Dim ZipFile         As String
    Dim ZipFileWithPath As String
      
    Dim ShZipFolder     As Object
    Dim ShFolderItem    As Object
       
    '=====================================
    ' Name FilePath and zip file name
    '=====================================
    FilePath = "c:\condor\port\abc"
    FilePathSlash = FilePath & "\"
   
    ZipFile = "TEST.ZIP"
    ZipFileWithPath = FilePathSlash + ZipFile
   
    '=================
    ' Create zip File
    '================
    Open ZipFileWithPath For Output As #1
    Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
    Close #1
   
    '=================================
    ' Loop through the files desired
    '=================================
           
    FiletoAdd = Dir(FilePathSlash & "*xyz*.*")
   
    While FiletoAdd <> vbNullString
   
        Set Sh = CreateObject("Shell.Application")
   
        With Sh
   
            Set ShZipFolder = .Namespace(ZipFileWithPath)

            '======================================
            'THIS IS THE PROBLEM MINE THAT BLOWS UP
            Set ShFolderItem = .Namespace(FilePath).Items().Item(ZipFileWithPath) ' <--- THIS IS THE LINE THAT BLOWS UP
            '======================================
           
            ShZipFolder.MoveHere ShFolderItem 'don't know if this works since never got here
       
            DoEvents
   
        End With
      
        FiletoAdd = Dir
       
    Wend

End Sub

 

[rollis13]

I trimmed your macro to this:

Sub ZipFiles()
    Dim FilePathSlash As String
    Dim ZipFileName As Variant    '<= changed
    Dim FileToAdd As String
    Dim Sh     As Object
    'Name file path and zip file name
    FilePathSlash = "C:\port\ABC\"
    ZipFileName = FilePathSlash & "Test.zip"
    'Create empty Zip File with zip header
    Open ZipFileName For Output As #1
    Print #1, Chr$(80) & Chr$(75) & Chr$(5) & Chr$(6) & String(18, 0)
    Close #1
    'Loop through the files desired
    Set Sh = CreateObject("Shell.Application")
    FileToAdd = Dir(FilePathSlash & "*XYZ*.*")
    While FileToAdd <> vbNullString
        With Sh
            .Namespace(ZipFileName).MoveHere FilePathSlash & FileToAdd
        End With
        'Give it time to update zip file
        Application.Wait (Now + TimeValue("0:00:01"))    '<= added
        FileToAdd = Dir
    Wend
End Sub

 

[Roncondor]

THANK YOU!!! THANK YOU!!

just one thing I think it should be switched to .copyhere and NOT .movehere

The movehere deleted the files

THANK YOU AGAIN!!!

 

[rollis13]

Oh, yes, sorry I was testing both cases and then forgot to mention it as a possible choice.
I'm glad I've been of some help .