VBA macro to winzip files located in a folder to different folder & repeat thru list

kthorson16 · Sep 29, 2015

VBA macro to winzip files located in a folder to different folder & repeat thru list

I need some help with getting VBA code.
I have a range of folder locations on an excel spreadsheet listed as: "P:\2015\07_Jul\Financial Statements\New Deals\Delivery Information\Agnesian" (range on spreadsheet of these locations is: J7:J51), each cell has a specific location of a folder with sub folders that I need to have zipped and saved into the follow location P:\FTP. I would like it to continue thru this process until it reaches a cell that contains "P:\\\Financial Statements\\Delivery Information\" in range J7:J51.
I have windows 10 and I am trying to do with this using Winzip
Can anyone help me with this code?

danwagnerco · Oct 7, 2015

Hey @kthorson16 -- a few questions regarding your situation.

What should the zip files be named? Agnesian.zip, for example?
Does the stop cell match "P:\\\Financial Statements\\Delivery Information\" exactly, or does the stop cell simply contain that text?
Are you able to use the freely-available 7-zip instead of WinZip, or is WinZip a requirement?

Given those answers, we should be able to help!

kthorson16 · Oct 7, 2015

This is the code that I currently have and it works. Now I am trying to encrypt each winzip file with a password for each file that would be located in column k (each password is different for each file). Would you be able to help add this function?

Sub cmdZip_Click()
Dim Dir_name As String
Dim rDirList As Range
Dim sDir2StopAt As String
Dim sZipEXEpath As String
Dim sZipDestPath As String
Dim sZipFileNm As String
Dim iAnswer As Long
Dim rCell As Range
Dim ff As Long
Dim sLogfnm As String
Dim sZipLogMsg As String
Dim oWShell As Object
Dim RtrnCode As Long
Dim sErrors As String

sZipEXEpath = "C:\Program Files\WinZip\"
sZipExeName = "WZZIP.EXE" ' This is the command line add-on EXE name. Change if needed.
sDir2StopAt = "P:\\\Financial Statements\\Delivery Information\" ' Your 'Stop Process' Flag THIS IS FOUND IN COLUMN J.
sZipDestPath = "C:\Users\kthors2\Desktop\Test\" ' "P:\2015\" ' Your Destination path for the zip files to be saved to.
sLogfnm = "Fin_Stmnt_ZipLog.txt" ' Log File Name. Shows results of proccessing. This will be saved in the Destination folder specified above.
' ********************************************************************

Set rDirList = Sheets("Test").Range("f4:f189")
''**********************************************************

If Right(Trim(sZipEXEpath), 1) <> "\" Then sZipEXEpath = sZipEXEpath & "\"
If Right(Trim(sZipDestPath), 1) <> "\" Then sZipDestPath = sZipDestPath & "\"

' TEST-Make sure we have a good path and file name for the WZZIP.exe
If Len(Dir(sZipEXEpath & sZipExeName)) = 0 Then
sErrors = sErrors & Date & " " & Time & " - ERROR: Invalid path/file name for .EXE: '" & sZipEXEpath & sZipExeName & "'" & vbCrLf
End If
' TEST-Make sure destination path is valid.
If Len(Dir(sZipDestPath, vbDirectory)) = 0 Then
sErrors = sErrors & Date & " " & Time & " - ERROR: Destination folder not found: '" & sZipDestPath & "'" & vbCrLf
End If
'TEST-Make sure the 'STOP' string is found somewhere in the range before we start to loop through.
Set rStopCell = rDirList.Find(sDir2StopAt, , xlValues, xlWhole)
If rStopCell Is Nothing Then
sErrors = sErrors & Date & " " & Time & " - ERROR: Process halted. The 'Stop' string not found. Looking for: '" & sDir2StopAt & "'" & vbCrLf
End If
If Len(sErrors) > 0 Then
' One or more of the above Tests failed.
GoTo Err_Handler
Else
If Right(Trim(sDir2StopAt), 1) <> "\" Then sDir2StopAt = sDir2StopAt & "\"

Set oWShell = CreateObject("Wscript.Shell")

For Each rCell In rDirList
iAnswer = 0
Dir_name = Trim(rCell.Value)
If Right(Trim(Dir_name), 1) <> "\" Then Dir_name = Dir_name & "\"

If UCase(Dir_name) = UCase(sDir2StopAt) Then Exit For

sZipFileNm = Trim(rCell.Offset(0, 2).Value)
sZipFileNm = sZipFileNm & ".zip"

If Dir(Dir_name, vbDirectory) <> "" Then

RtrnCode = oWShell.Run("""" & sZipEXEpath & sZipExeName & """ " & " -r -p " & """" & sZipDestPath & sZipFileNm & """ " & """" & Dir_name & "*.*" & """", 0, True)

If RtrnCode = 0 Then
'success!
sZipLogMsg = Date & " " & Time & ": Successful Zip: " & sZipDestPath & sZipFileNm

Else
sZipLogMsg = Date & " " & Time & ": Failed to Zip: " & sZipDestPath & sZipFileNm
'warn the user
iAnswer = MsgBox("Zip Failed for:" & vbCrLf & Dir_name & sZipFileNm & vbCrLf & _
"Do You want to continue process?", vbYesNo + vbCritical, "Zip Process Failure")

End If
Else 'Dir not found
sZipLogMsg = Date & " " & Time & ": Failed, Directory not found: " & Dir_name
'warn the user
iAnswer = MsgBox("Directory not found:" & vbCrLf & Dir_name & vbCrLf & _
"Do You want to continue process?", vbYesNo + vbCritical, "Directory Not found")
End If

If iAnswer = vbNo Then sZipLogMsg = sZipLogMsg & vbCrLf & Date & " " & Time() & ": User Halted process."

' Write to log file.
ff = FreeFile
Open sZipDestPath & sLogfnm For Append As #ff
Print #ff, sZipLogMsg
Close #ff

If iAnswer = vbNo Then Exit For
Next
End If

GoTo Exit_Sub

Err_Handler:

If Len(sErrors) > 0 Then
sErrors = Left(sErrors, Len(sErrors) - 2) ' get rid of last crlf
If Dir(sZipDestPath, vbDirectory) <> "" Then
' path is bad, so we can't write to the log. skip it.
ff = FreeFile

Open sZipDestPath & sLogfnm For Append As #ff
Print #ff, sErrors
Close #ff
sErrors = sErrors & vbCrLf & vbCrLf & "For details, see log file:" & vbCrLf & sZipDestPath & sLogfnm
Else
sErrors = sErrors & vbCrLf & vbCrLf & "Log File: " & "'" & sZipDestPath & sLogfnm & "'" & vbCrLf & vbCrLf & "ERROR: BAD PATH/FILE. CANNOT WRITE TO LOG FILE!"

End If

x = MsgBox(sErrors, vbCritical + vbOKOnly, "Process ended with ERRORS")
Else
' lots of thing can go wrong. Its up to you to catch them and handle them.
MsgBox "Error: " & Err.Number & vbCrLf & Err.Description

End If

Close #ff

Exit_Sub:
If (iAnswer = 0) And (Len(sErrors) = 0) Then
MsgBox "Finished. For details, see log file: " & vbCrLf & sZipDestPath & sLogfnm
Else
' MOVED this to the Err_Handler:

End If

End Sub

danwagnerco · Oct 7, 2015

A quick google search revealed that at some point in time, the WinZip command line interface allowed for setting a password via the "-s" flag (like so):

Code:

WZZIP.exe -s"YourPasswordGoesHere"

(I'm relying on Google here though, and those search results could be old -- you should check your WinZip documentation.)

In the code you provided below, a call to the WshShell.Run method handles all of your interactions with WZZIP.exe.

Code:

[COLOR=#3E3E3E]RtrnCode = oWShell.Run("""" & sZipEXEpath & sZipExeName & """ " & " -r -p " & """" & sZipDestPath & sZipFileNm & """ " & """" & Dir_name & "*.*" & """", 0, True)
[/COLOR]

This means you need to add the "-s" flag:

Code:

Dim sPasswordAndFlag As String ' <~ a variable to store the password in column K and the "-s" flag

Code:

[COLOR=#3E3E3E]For Each rCell In rDirList
    'lots happens in here
    '...
    sPasswordAndFlag = " -s" & Chr(34) & Trim(rCell.Offset(0, 1).Value) & Chr(34)
    '...
    'lots more happens here
Next
[/COLOR]

You may need to adjust the sPasswordAndFlag equation above though, as it seems your code is actually looping through Sheets("Test").Range("f4:f189") (rather than column K as originally described).

Can you share the Workbook?

snb · Oct 7, 2015

You can reduce this whole code to:

Code:

Sub cmdZip_Click()
  sn = Sheets("Test").Range("f4:g189")
  c00 = "C:\Program Files\WinZip\WZZIP.EXE"
  c01 = "C:\Users\kthors2\Desktop\Test\"
  
  For j = 1 To UBound(sn)
    Shell Chr(34) & c00 & """ -r -p """ & c01 & sn(j, 2) & ".zip"" """ & sn(j, 1) & "*.*""", 0
  Next
End Sub

kthorson16 · Oct 7, 2015

Workbook attached

here is the attached workbook.

danwagnerco · Oct 8, 2015

A few adjustments to your code should let you encrypt each zip with the password from column K.

First, you should add two new variables, sPasswordAndFlag and sCommand:

Code:

Sub cmdZip_Click()
Dim Dir_name As String
'... many more variables declared here
'...
'...
Dim sPasswordAndFlag As String ' <~ new variable, will hold the flag and password
Dim sCommand As String ' <~ new variable, will hold the full shell command

Then, immediately following the check that verified Dir_name exists, you will form the sPasswordAndFlag variable:

Code:

If Dir(Dir_name, vbDirectory) <> "" Then
    sPasswordAndFlag = " -s" & Chr(34) & _
                       Trim(rCell.Offset(0, 5).Value) & _
                       Chr(34) & " "

What's going on in that assignment? Though it looks scary, it really is not:

Chr(34) is the double quote character
Trim(rCell.Offset(0, 5).Value) gives you the cell 5 to the right of rCell, which is looping through column F. 5 columns to the right of F is column K!

If you were to Debug.Print the sPasswordAndFlag variable, it would look like this:

Code:

 -s"5075400Acp!"

Nice! Let's use this variable in the context of the FULL command that we eventually send to oWShell.Run. Immediately following the sPasswordAndFlag assignment, let's assign sCommand:

Code:

sCommand = Chr(34) & sZipEXEpath & sZipExeName & Chr(34) & _
           sPasswordAndFlag & "-r -p " & Chr(34) & _
           sZipDestPath & sZipFileNm & Chr(34) & " " & _
           Chr(34) & Dir_name & "*.*" & Chr(34)

Whoa! Again, this assignment looks scary, but if we break it up step by step it is not:

Chr(34) is the double quote character
sZipEXEpath was already set equal to "C:\Program Files\WinZip\" at the top of this script
sZipExeName was already set equal to "WZZIP.EXE" at the top of this script
sPasswordAndFlag is the string we created just a moment ago
sZipDestPath was already set equal to "C:\Users\kthors2\Desktop\Test\" at the top of this script
sZipFileNm was already set to Trim(rCell.Offset(0, 2).Value) & ".zip" a few lines above in this script
Dir_name was created a couple lines above sZipFileNm and set to Trim(rCell.Value)

Cool! If we were to Debug.Print the sCommand variable, it would look like this:

Code:

"C:\Program Files\WinZip\WZZIP.EXE" -s"5075400Acp!" -r -p "C:\Users\kthors2\Desktop\Test\AHN.2015.zip" "P:\2015\08_Aug\Financial Statements\New Deals\Delivery Information\AHN\*.*"

One more step! Since the full command is now stored in sCommand, you should modify the RtrnCode line to be:

Code:

RtrnCode = oWShell.Run(sCommand, 0, True)

The 0 tells the Windows Host Shell object to run invisibly, and the True tells VBA to wait until the shell command finishes to continue running.

Your zip files should now be encrypted :high5:

kthorson16 · Oct 8, 2015

Are you able to help with code so it loops thru a list of passwords?

danwagnerco · Oct 8, 2015

I wrote a response last night to the question, but got a message saying it was pending moderator approval...

Mods: where can I see pending posts?

kthorson16 · Oct 8, 2015

I am not sure where you can see pending posts.

danwagnerco · Oct 9, 2015

Here's a re-write...
--
To enable password-protection on each zip file, you can start by adding two new variables at the top of your script:

Code:

Sub cmdZip_Click()
Dim Dir_name As String
Dim rDirList As Range
'...
'... many more variables
'...
Dim sPasswordAndFlag As String, sCommand As String

sPasswordAndFlag will hold the "-s" flag as well as the password (wrapped with double quotes), and sCommand will hold the full command that will eventually be passed to oWShell.Run.

The next step is to define sPasswordAndFlag, which should happen immediately after the check for Dir_name:

Code:

If Dir(Dir_name, vbDirectory) <> "" Then ' <~ you already have this, the next line is new
    sPasswordAndFlag = " -s" & Chr(34) & _
                       Trim(rCell.Offset(0, 5).Value) & _
                       Chr(34) & " "

Whoa! That assignment looks scary, but I promise it is not:

Chr(34) is the double quote character
Trim(rCell.Offset(0, 5).Value) gives you the value from the cell 5 to the right of rCell, which starts in cell F4. 5 columns to the right of F4 is K4, which is where our password text is!

If you were to call

Code:

Debug.Print sPasswordAndFlag

after that assignment, you would get this:

Code:

 -s"5075400Acp!"

Nice! Let's use sPasswordAndFlag to create the full command line text. On the next line after assigning sPasswordAndFlag, assign sCommand like this:

Code:

sCommand = Chr(34) & sZipEXEpath & sZipExeName & Chr(34) & _
               sPasswordAndFlag & "-r -p " & Chr(34) & _
               sZipDestPath & sZipFileNm & Chr(34) & " " & _
               Chr(34) & Dir_name & "*.*" & Chr(34)

Again, sCommand looks scary but is not when you look at it broken up into little bits:

Chr(34) is the double quote character
sZipEXEpath is defined at the top as "C:\Program Files\WinZip\"
sZipExeName is defined at the top as "C:\Program Files\WinZip\"
sPasswordAndFlag is defined above
sZipDestPath is defined at the top as "C:\Users\kthors2\Desktop\Test\"
sZipFileNm is defined a few lines above sPasswordAndFlag as Trim(rCell.Offset(0, 2).Value) & ".zip"
Dir_name is defined a few lines above sZipFileNm as Trim(rCell.Value)

If you were to call Debug.Print sCommand, you would get this:

Code:

"C:\Program Files\WinZip\C:\Program Files\WinZip\" -s"5075400Acp!" -r -p "C:\Users\kthors2\Desktop\Test\AHN.2015.zip" "P:\2015\08_Aug\Financial Statements\New Deals\Delivery Information\AHN\*.*"

Cool! Since the full command is now stored in sCommand, you should change the RtrnCode statement to:

Code:

RtrnCode = oWShell.Run(sCommand, 0, True)

(In case you are wondering, the 0 means the Windows Host Script object should run in an invisible window, and the True means that VBA should wait until this command finishes before proceeding.)

kthorson16 · Oct 16, 2015

Thank you for your help.
I am running into one issue the code is getting hung up. When i trouble the code it is open WINZIP command but it is not entering the password which it needs to do two times.

I have modified the code you provided me a little but in the end it is doing the same thing:

For Each rCell In rDirList
iAnswer = 0
Dir_name = Trim(rCell.Value)
If Right(Trim(Dir_name), 1) <> "\" Then Dir_name = Dir_name & "\"

If UCase(Dir_name) = UCase(sDir2StopAt) Then Exit For

sZipFileNm = Trim(rCell.Offset(0, 2).Value)
sZipFileNm = sZipFileNm & ".zip"

If Dir(Dir_name, vbDirectory) <> "" Then
sPasswordAndFlag = " -s" & Chr(34) & _
Trim(rCell.Offset(0, 5).Value) & _
Chr(34) & " "
Debug.Print sPasswordAndFlag
sCommand = Chr(34) & sZipEXEpath & sZipExeName & Chr(34) & "-r -p " & _
sPasswordAndFlag & Chr(34) & _
sZipDestPath & sZipFileNm & Chr(34) & " " & _
Chr(34) & Dir_name & "*.*" & Chr(34)
Debug.Print sCommand

'RtrnCode = oWShell.Run("""" & sZipEXEpath & sZipExeName & """ " & " -r -p -s -s" & Chr(34) & " " & sZipDestPath & sZipFileNm & Chr(34) & Chr(34) & Dir_name & "*.*" & Chr(34), 0, True)
StrHello = oWShell.Run("""" & sZipEXEpath & sZipExeName & """ " & " -r -p -s -s" & Chr(34) & " " & sZipDestPath & sZipFileNm & Chr(34) & Chr(34) & Dir_name & "*.*" & Chr(34))
MsgBox StrHello

kthorson16 · Oct 21, 2015

Do you have any idea on how to resolve my issue?

danwagnerco · Oct 25, 2015

Not sure I 100% understand the issue...

WinZip requires the password to be entered twice from the command line? Can you point me to the command line docs for WinZip that you're using, or show me how that info needs to be entered?

Assuming that there is a "prompt" from the command line, you could take advantage of the WshShell.SendKeys method:

https://msdn.microsoft.com/en-us/library/8c6yea83(v=vs.84).aspx

We know that the password is stored 5 columns to the right of our iterator, so this would do the trick:

Code:

oWShell.SendKeys(CStr([COLOR=#333333]Trim(rCell.Offset(0, 5).Value)[/COLOR]))

VBA macro to winzip files located in a folder to different folder & repeat thru list

kthorson16

New member

danwagnerco

New member

kthorson16

New member

danwagnerco

New member

snb

New member

kthorson16

New member

Attachments

danwagnerco

New member

kthorson16

New member

danwagnerco

New member

kthorson16

New member

danwagnerco

New member

kthorson16

New member

kthorson16

New member

danwagnerco

New member