I am trying to write a code that:
First Prompt: asks the user to select the folder that contains all zipped folders where each zipped folder contains a data file.
Second Prompt: Ask the user to select the master folder path to place the unzipped data files into.
The program will unzip the first zipped folder, copy the data file out, paste the data file into the designated master folder the user was prompted to select from their second prompt.
The program will find the next zipped folder, unzip and open the folder, copy out the file it contains, paste the file into the master folder, rinse and repeat until all the files from each of the zipped folders are moved over.
I am trying to make a folder that contains all the zipped data files in order to concatenate all the data into a master document. Then I will be able to run an analysis on this data.
This code works but I need some help with getting the code to run faster. I tested the program on a folder that contained only 6 zipped files and it moved the files over in 2 seconds. But now I'm testing the program on a folder that contains 8020 zipped files and its moving over the files at a rate of 1 file every 8 seconds.
I have "Microsoft Shell Controls And Automation", "Visual Basic For Applications", "Microsoft Excel 15.0 Object Library", OLE Automation", "Microsoft Office 15.0 Object Library", Microsoft Forms 2.0 Objection Library" options enabled.
Can anyone help me speed this up?
Option Explicit
Sub UnzipFileMoveToMasterFolder()
Dim oApp As Shell
Dim strFile As String
Dim FolderPath As FileDialog
Dim MasterFolder As String
Dim ZipFolder As String
Dim i As Integer
'Optimize Macro Speed
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Application.DisplayAlerts = False
'Retrieve target master workbook data folder path from user
Set FolderPath = Application.FileDialog(msoFileDialogFolderPicker)
With FolderPath
.Title = "Select a master folder location to store the unzipped files."
.AllowMultiSelect = False
If .Show <> -1 Then GoTo CancelSelect1
MasterFolder = .SelectedItems(1) & "\"
End With
'In case Cancel selected
CancelSelect1:
MasterFolder = MasterFolder
If MasterFolder = "" Then GoTo ResetSettings
'Retrieve target data folder path from user
Set FolderPath = Application.FileDialog(msoFileDialogFolderPicker)
With FolderPath
.Title = "Select folder location that contains the zipped folders with desired data files."
.AllowMultiSelect = False
If .Show <> -1 Then GoTo CancelSelect2
ZipFolder = .SelectedItems(1) & "\"
End With
'In case Cancel selected
CancelSelect2:
ZipFolder = ZipFolder
If ZipFolder = "" Then GoTo ResetSettings
'get a shell object
Set oApp = CreateObject("Shell.Application")
'get all the files in the directory that are zip files
strFile = Dir(ZipFolder & "*.zip")
'loop until we cannot find anymore files
Do While strFile <> ""
'check to see if the zip contains items
If oApp.Namespace(ZipFolder).Items.Count > 0 Then
'loop through all the items in teh zip file
For i = 0 To oApp.Namespace(ZipFolder).Items.Count - 1
'save the files to the new location
oApp.Namespace(MasterFolder).CopyHere oApp.Namespace(ZipFolder & strFile).Items.Item(i)
Next i
End If
'get the next file in the directory
strFile = Dir
Loop
'free memory
Set oApp = Nothing
'Reset Macro Optimization Settings
ResetSettings:
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayAlerts = True
'Message Box when tasks are completed
MsgBox "Task Complete!"
Application.Cursor = xlDefault
End Sub