-
-
Save danwagnerco/0a7a44ebe1b5d8251e53 to your computer and use it in GitHub Desktop.
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
Hi,
I am hoping you can help, i get a "User-defined type not defined" error and the this line of the code is highlighted "Dim wsh As WshShell", i appreciate your assistance on this