This script loops through a column and creates zip files for each folder listed using 7-Zip

zip_folders_in_column.vb

Option Explicit
Public Sub ZipFoldersInColumn()
    
    Dim wks As Worksheet
    Dim lngIdx As Long, lngErrorCode
    Dim strFullPath As String, strZipName As String, strEndFound As String, _
        strCommand As String, strTargetDir As String
    Dim blnEndFound As Boolean
    Dim wsh As WshShell
    Set wsh = New WshShell
    
    'Set references up-front
    Set wks = ThisWorkbook.Worksheets("Sheet1")
    blnEndFound = False
    lngIdx = 7
    strTargetDir = "C:\target-folder\" ' <~ adjust as necessary
    strEndFound = "Arbitrary Stop String" ' <~ adjust as necessary
    
    'Loop through column J from rows 7 to 51
    While Not blnEndFound
    
        'Assign the full filepath per the listing in the cell, then increment
        strFullPath = wks.Cells(lngIdx, 10).Value
        lngIdx = lngIdx + 1
        
        'Make sure we're not at the end of the range or stop string
        If strFullPath <> strEndFound And lngIdx < 51 Then
        
            'Get the appropriate zip file name
            strZipName = GetZipFileName(strFullPath)
            
            'Form the 7-zip command line instruction
            strCommand = Chr(34) & "C:\Program Files\7-Zip\7z.exe" & Chr(34) & _
                         " a -tzip " & _
                         Chr(34) & strTargetDir & strZipName & Chr(34) & _
                         " " & Chr(34) & strFullPath & "\" & "*" & Chr(34)
            
            'Run the 7-zip command line instruction via thw WshShell
            lngErrorCode = wsh.Run(strCommand, WindowStyle:=1, WaitOnReturn:=1)
            
            'Check for an error from WshShell
            If lngErrorCode <> 0 Then
                MsgBox "Oh no! Something went wrong with Wsh!"
                Exit Sub
            End If
        Else
            blnEndFound = True
        End If
    
    Wend
    
    'Let the user know the script has finished
    MsgBox "Zip files created!"
End Sub

Public Function GetZipFileName(FullPath As String) As String
    
    Dim lng As Long
    Dim str As String
    Dim blnCharIsASlash As Boolean
    
    'Set references up-front
    blnCharIsASlash = False
    lng = 0
    
    'Walk backwards from the end of the full file path until "\"
    While Not blnCharIsASlash
        str = Mid(FullPath, Len(FullPath) - lng, 1)
        If str = "\" Then
            blnCharIsASlash = True
        End If
        lng = lng + 1
        
        'Prevent an infinite loop by stopping at 1,000
        If lng >= 1000 Then
            MsgBox "Whoa! I got to 1000 counts before finding '\', " & _
                   "something is wrong!"
            GetZipFileName = ""
        End If
    Wend
    
    GetZipFileName = Right(FullPath, lng - 1) & ".zip"
    
End Function

Hey @rhomajay -- I am guessing that the "Windows Script Host Object Model" reference is not set.

In the VBA editor, you'll want to click "Tools" then click "References...", and in the window that opens up you need to select "Windows Script Host Object Model" like this:

From there, the code should compile correctly.

However, if you need to deliver this code in a way that does NOT stay attached to an Excel workbook with the "Windows Script Host Object Model" enabled, you would be a in a pickle -- you can't ask end users to click around in the VBA editor, right?

Fortunately, there is a solution for that too. If you cannot guarantee that your user will have the "Windows Script Host Object Model" reference, then you can use CreateObject:

Public Sub Test()

    'Dim wsh As WshShell
    'Set wsh = New WshShell
    '^-- if you cannot do this, then do that:

    Dim obj As Object
    Set obj = CreateObject("WScript.Shell")

End Sub

Thanks and good luck @rhomajay! -Dan

Hello @rhomajay -- you will need to dump the error code (lines 39-42, stored in variable lngErrorCode) and investigate further.

Once you know the error number I recommend googling that error number to learn more.

Thanks! -Dan