Macro to move zip file from one location to another, extract, then delete zip if possible

steallan

Active Member
Joined
Oct 20, 2004
Messages
304
Hi

Can anyone help me by writing a macro that can move a zip file from a specific folder, put it in a new specific folder elsewhere on the drive, extract it in that location, then delete the zip?

The delete is the least important part. When it moves it initially it would be best if it was cut, but if its easier to copy and paste that works as well.

The main trick is identifying the zip file to move. I need the macro to do this itself by finding yesterday's date in the file name, and if the word TAP is present.

Example filename:

20191113 - UU TAP Form Return - 44.zip

so the code would have to find that, today. So something like Filename Contains System date (yyyymmdd) -1, and "TAP". The date my not be at the start of the name, but eslewhere in the string.

My VBA skills are capable of little more than altering addresses in existing code, i've got no chance of being able to write this myself.

If anyone can help, i'd really appreciate it.

Thanks

Ste
 

Some videos you may like

Excel Facts

Does the VLOOKUP table have to be sorted?
No! when you are using an exact match, the VLOOKUP table can be in any order. Best-selling items at the top is actually the best.

John_w

MrExcel MVP
Joined
Oct 15, 2007
Messages
6,312
Try this macro. Note that it doesn't move or copy the zip file, but simply unzips it to the destination folder and deletes it from its original folder. Any existing files in the destination folder are overwritten. Whilst testing, and before running the macro, I suggest you copy the zip file to a different folder if you want to restore it.

Change the sourceFolder and destinationFolder strings as required.

Code:
Public Sub Find_and_Unzip()

    Dim sourceFolder As String, destinationFolder As String
    Dim zipFileName As String, foundZipFileName As String
    Dim Sh As Shell32.Shell
    Dim CopyHereFlags As Variant
                
    sourceFolder = "C:\path\to\zip files\"         'source folder containing .zip file to be unzipped
    destinationFolder = "C:\path\to\unzipped\"     'destination folder for .zip file's unzipped contents
    
    If Right(sourceFolder, 1) <> "\" Then sourceFolder = sourceFolder & "\"
    If Right(destinationFolder, 1) <> "\" Then destinationFolder = sourceFolder & "\"
    
    'https://docs.microsoft.com/en-us/windows/desktop/shell/folder-copyhere
    '   4   Do not display a progress dialog box.
    '   16  Respond with "Yes to All" for any dialog box that is displayed.
    
    CopyHereFlags = 4 + 16
    
    'Find yesterday's .zip file
    
    foundZipFileName = ""
    zipFileName = Dir(sourceFolder & "*" & Format(Date - 1, "yyyymmdd") & "*.zip")
    While zipFileName <> vbNullString And foundZipFileName = ""
        If InStr(1, zipFileName, "TAP", vbTextCompare) Then foundZipFileName = zipFileName
        zipFileName = Dir()
    Wend
    
    If foundZipFileName <> "" Then
    
        'Unzip all files in the .zip file to the destination folder
            
        Set Sh = CreateObject("Shell.Application")
        With Sh
            'Note - Namespace argument enclosed in brackets to force 'pass by value'
            .Namespace((destinationFolder)).CopyHere .Namespace((sourceFolder & foundZipFileName)).Items, CopyHereFlags
        End With
    
        'Delete the .zip file
        
        Kill sourceFolder & foundZipFileName
        
        MsgBox sourceFolder & foundZipFileName & " unzipped to " & destinationFolder, vbInformation
        
    Else
    
        MsgBox "There are no matching files in " & sourceFolder, vbExclamation
    
    End If
    
End Sub
 

steallan

Active Member
Joined
Oct 20, 2004
Messages
304
Thanks John this is amazing! Looks to be just what I need, but I get an error when i run it on:

User-Defined type not defined

on:

Sh As Shell32.Shell


alas I lack the skills to know why.
 

steallan

Active Member
Joined
Oct 20, 2004
Messages
304
It works like a charm! Thanks a million. There's actually a few types of files in the same folder, i'll be able to use slightly different versions of this code as a Run Before event in a few different workflows, to COMPLETELY automate processes.

John, you're great, thank you again.
 

steallan

Active Member
Joined
Oct 20, 2004
Messages
304
Is there anyway to change it slightly to not delete the folder that the unzipped files were in?

the folder creation might be a result of my manual extract process. When I do it manually, the files are placed into a folder sharing the zip file's name. That folder was really handy as the zip file name contains useful info about the files within. Namely the date.

if no such folder actually exists, can the macro create one of the same name as the zip file and put the files in there?
 

John_w

MrExcel MVP
Joined
Oct 15, 2007
Messages
6,312
I don't see how the macro is deleting the destination folder, however I've just noticed a bug which would put the unzipped files in the incorrect folder.

This line:
VBA Code:
    If Right(destinationFolder, 1) <> "\" Then destinationFolder = sourceFolder & "\"
should be:
VBA Code:
    If Right(destinationFolder, 1) <> "\" Then destinationFolder = destinationFolder & "\"
As for putting the unzipped files in a folder with the same name as the zip file, and creating it if it doesn't exist, please try this macro. Also, instead of hard-coding the source and destination folders, I've added 2 folder browse dialogues. Note that the destination folder (browsed or hard-coded), should be the parent folder of the subfolder in which the files will be unzipped. This subfolder will be created with the same name as the .zip file, without the .zip extension, if it doesn't exist.

VBA Code:
Public Sub Find_and_Unzip2()

    Dim fd As FileDialog
    Dim sourceFolder As String, destinationFolder As String
    Dim zipFileName As String, foundZipFileName As String
    Dim Sh As Object
    Dim CopyHereFlags As Variant
               
'    sourceFolder = "C:\path\to\zip files\"         'source folder containing .zip file to be unzipped
'    destinationFolder = "C:\path\to\unzipped\"     'parent folder containing a subfolder, same name as the .zip file and created if it doesn't exist, for .zip file's unzipped contents

'    If Right(sourceFolder, 1) <> "\" Then sourceFolder = sourceFolder & "\"
'    If Right(destinationFolder, 1) <> "\" Then destinationFolder = destinationFolder & "\"
   
    Set fd = Application.FileDialog(msoFileDialogFolderPicker)
    With fd
        .Title = "Select the folder containing zip files"
        .AllowMultiSelect = False
        .InitialFileName = Application.DefaultFilePath
        If .Show = False Then Exit Sub
        sourceFolder = .SelectedItems(1) & "\"
    End With
   
    With fd
        .Title = "Select the parent folder containing destination subfolder for unzipped files"
        .AllowMultiSelect = False
        .InitialFileName = sourceFolder 'Application.DefaultFilePath
        If .Show = False Then Exit Sub
        destinationFolder = .SelectedItems(1) & "\"
    End With
   
    'https://docs.microsoft.com/en-us/windows/desktop/shell/folder-copyhere
    '   4   Do not display a progress dialog box.
    '   16  Respond with "Yes to All" for any dialog box that is displayed.
   
    CopyHereFlags = 4 + 16
   
    'Find yesterday's .zip file
   
    foundZipFileName = ""
    zipFileName = Dir(sourceFolder & "*" & Format(Date - 1, "yyyymmdd") & "*.zip")
    While zipFileName <> vbNullString And foundZipFileName = ""
        If InStr(1, zipFileName, "TAP", vbTextCompare) Then foundZipFileName = zipFileName
        zipFileName = Dir()
    Wend
   
    If foundZipFileName <> vbNullString Then
   
        'Create final destination folder if it doesn't exist
       
        destinationFolder = destinationFolder & Left(foundZipFileName, InStrRev(foundZipFileName, ".") - 1)
        If Dir(destinationFolder, vbDirectory) = vbNullString Then MkDir destinationFolder
       
        'Unzip all files in the .zip file to the destination folder
       
        Set Sh = CreateObject("Shell.Application")
        With Sh
            'Note - Namespace argument enclosed in brackets to force 'pass by value'
            .Namespace((destinationFolder)).CopyHere .Namespace((sourceFolder & foundZipFileName)).Items, CopyHereFlags
        End With
   
        'Delete the .zip file
       
        Kill sourceFolder & foundZipFileName
       
        MsgBox sourceFolder & foundZipFileName & " unzipped to " & destinationFolder, vbInformation
       
    Else
   
        MsgBox "There are no matching files in " & sourceFolder, vbExclamation
   
    End If
   
End Sub
 

steallan

Active Member
Joined
Oct 20, 2004
Messages
304
Glorious, is the best word to describe that macro. Works like a charm and I get my files in my correctly named folder.

Its unlikely i'll ever bump into you and be able to buy you a pint John, but I hope so.

Thank you.
 

Watch MrExcel Video

Forum statistics

Threads
1,102,185
Messages
5,485,246
Members
407,490
Latest member
leogaleleo84

This Week's Hot Topics

  • Finding issue in If elseif else with For each Loop
    Finding issue in If elseif else with For each Loop I have tried this below code but i'm getting in Y column filled with W005. Colud you please...
  • MsgBox Error
    Hi Guys, I have the below error show up when i try and run my macro in File1 but works fine if i copy and paste the same code into file2. [ATTACH...
  • CELL FORMAT - IF CONDITION
    My Cell Format is [B]""0.00" Cr". [/B]But in the cell, it is showing 123.00 for editing. (123 is entry figure). (Data imported from other...
  • Show numbers nearly the same
    Is this possible. I have a number that can change very time eg 0.00001234 Then I have a lot of numbers 0.0000001, 0.0000002, 0.00000004...
  • Please i need your help to create formula
    I need a formula in cell B8 to do this >>if b1=1 then multiply ( cell b8) by 10% ,if b1=2 multiply by 20%,if=3 multiply by 30%. Thank you in...
  • Got error while adding column and filter
    Got error while adding column and filter In column Z has some like "Success" and "Error". I want to add column in AA if the Z cell value is...
Top