Page 1 of 2 1 2 LastLast
Results 1 to 10 of 14

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

  1. #1

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



    Register for a FREE account, and/
    or Log in to avoid these ads!

    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?

  2. #2
    Acolyte danwagnerco's Avatar
    Join Date
    Sep 2015
    Location
    Chicago, IL, USA
    Posts
    30
    Articles
    0
    Hey @kthorson16 -- a few questions regarding your situation.


    1. What should the zip files be named? Agnesian.zip, for example?
    2. Does the stop cell match "P:\\\Financial Statements\\Delivery Information\" exactly, or does the stop cell simply contain that text?
    3. 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!

  3. #3
    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

  4. #4
    Acolyte danwagnerco's Avatar
    Join Date
    Sep 2015
    Location
    Chicago, IL, USA
    Posts
    30
    Articles
    0
    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:
    RtrnCode = oWShell.Run("""" & sZipEXEpath & sZipExeName & """ " & " -r -p " & """" & sZipDestPath & sZipFileNm & """ " & """" & Dir_name & "*.*" & """", 0, True)
    


    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:
    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
    


    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?


  5. #5
    Conjurer snb's Avatar
    Join Date
    May 2013
    Posts
    375
    Articles
    0
    Excel Version
    2020
    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

  6. #6

    Workbook attached

    here is the attached workbook.
    Attached Files Attached Files

  7. #7
    Acolyte danwagnerco's Avatar
    Join Date
    Sep 2015
    Location
    Chicago, IL, USA
    Posts
    30
    Articles
    0
    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

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

  9. #9
    Acolyte danwagnerco's Avatar
    Join Date
    Sep 2015
    Location
    Chicago, IL, USA
    Posts
    30
    Articles
    0
    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?

  10. #10
    I am not sure where you can see pending posts.

Page 1 of 2 1 2 LastLast

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •