Home > Macros > Basics > Zip Files Update and Zip Excel FilesUse this macro to update all files in a specific folder, with an option to zip each file, after it is updated. The instructions and code are below, and download the free workbook. |
In this example, a macro will copy the master ContactInfo sheet from the sample file, and use it to replace the outdated ContactInfo sheets in other files.
The master file contains a list of folders, and you can select a specific folder to update, or let the macro run through all the folders in the list.
Finally, the code can also zip each updated file, and store the zipped file in a different folder.
The workbook contains the master sheet that will be used to update all the other files -- ContactInfo. This sheet contains a list of websites, with a hyperlink to each site.
The code will copy this sheet to each file (Excel 2007 and later).For Excel 2003 files, it will copy the range, and paste it onto the ContactInfo sheet in that file, because the sheet is larger than those in the old versions of Excel.
In your file, you could have different information on your master sheet, but be careful if the sheet contains the following, which might cause problems when copied to another workbook:
On the Setup sheet, fill in the orange cells, with your file information and preferences.
Below the orange cells, there is also a table, where you can enter a list of folders -- both the original files to be updated, and the folders where the zipped copies should be stored.
An ID number is typed in each row, to identify the folder. You will use one of those ID numbers in the "Folder # to update" cell, to specify which folder should be updated.
You can enter as many folders as you need -- just make sure that each folder has a unique ID number.
Before you test the sample code, be sure to make a backup of the files that you plan to update, and any existing zipped files.
If possible, make a testing folder, and add that to your list of file locations. Then, test that folder first, before using the macro on any other files.
On the Setup sheet, there is a button to run the Update macro.
="Update" & IF(rngZip="Yes"," & Zip","") & " Files"
Select the button shape
Click in the formula bar, and type this formula:
=$D$15
The Update Button will run a macro named UpdateContactSheet -- the code is shown below. This code should be added to a regular code module in a workbook, and there are instructions here: Add code to regular module.
After you add the code to your workbook, assign the macro to the button.
Here is the code that updates the files in the selected folder.
Sub UpdateContactSheet() Dim fso As Object Dim fldr As Object Dim file As Object Dim wb As Workbook Dim wbLinks As Workbook Dim wsFL As Worksheet Dim wsL As Worksheet Dim strPath As String Dim strFileFix As String Dim strMsg As String Dim strFile As String Dim strFileTest As String Dim strLinks As String Dim rngFLID As Range Dim rngID As Range Dim rngFldr As Range Dim lUpdate As Long Dim lFldr As Long Dim bRun As Boolean Dim bZip As Boolean Dim strCopy As String Dim strCols As String Dim ZipPath As String Dim ZipDestPath As String Dim ZipDest As String Dim ZipFile As String Dim strMsgEnd As String Application.ScreenUpdating = False Application.DisplayAlerts = False Application.EnableEvents = False On Error GoTo errHandler lUpdate = MsgBox("Update all files?", _ vbYesNo + vbDefaultButton2, "Update All?") If lUpdate <> vbYes Then GoTo exitHandler Set wbLinks = ThisWorkbook Set wsFL = wbLinks.Sheets("FileLocs") Set rngFLID = wsFL.Range("FileLocID") Set rngFldr = wsFL.Range("FldrZip") strFileTest = ".xls" strLinks = wsFL.Range("SheetCopy").Value strCopy = "A1:Z10" strCols = "A:Z" ZipPath = wsFL.Range("zippath").Value lFldr = rngFldr.Value Select Case wsFL.Range("rngZip").Value Case "Yes" bZip = True Case Else bZip = False End Select 'check for id For Each rngID In rngFLID If lFldr = 0 Then bRun = rngID > 0 Else bRun = rngID = lFldr End If If bRun = True Then strPath = rngID.Offset(0, 1).Value ZipDestPath = rngID.Offset(0, 2).Value If Right(strPath, 1) <> "\" Then strPath = strPath & "\" End If If Right(ZipDestPath, 1) <> "\" Then ZipDestPath = ZipDestPath & "\" End If strMsg = "Could not create the file path for import" Set fso = CreateObject("Scripting.FileSystemObject") If strPath <> "" Then Set fldr = fso.GetFolder(strPath) For Each file In fldr.Files strMsg = "Could not get file info for " & file.Name strFile = file.Name If InStr(1, strFile, strFileTest) > 0 Then strFileFix = strPath & strFile strMsg = "Could not update the link sheet" Workbooks.Open strFileFix, False Set wb = Workbooks(strFile) If Right(wb.Name, 3) = "xls" Then ''copy data into older files ''xlsm sheet will not fit in xls files On Error Resume Next Set wsL = wb.Sheets(strLinks) On Error GoTo errHandler If wsL Is Nothing Then Set wsL = wb.Sheets.Add _ (After:=wb.Sheets(wb.Sheets.Count)) wsL.Name = strLinks End If wbLinks.Sheets(strLinks).Range(strCopy).Copy _ Destination:=wb.Sheets(strLinks).Range("A1") wb.Sheets(strLinks).Columns(strCols) _ .EntireColumn.AutoFit Else On Error Resume Next wb.Sheets(strLinks).Delete On Error GoTo errHandler wbLinks.Sheets(strLinks).Copy _ After:=wb.Sheets(wb.Sheets.Count) End If wb.Activate 'delete any names created For Each nm In wb.Names strRefersTo = nm.RefersTo If InStr(1, strRefersTo, _ strWbName) > 0 Then nm.Delete End If Next nm wb.Sheets(1).Activate wb.Close SaveChanges:=True If bZip = True Then ZipDest = Chr(34) & ZipDestPath & _ Left(strFile, InStr(1, strFile, strFileTest)) _ & "zip" & Chr(34) strFileFix = Chr(34) & strFileFix & Chr(34) 'Note spaces are important ZipFile = Shell(ZipPath & "7zG.exe a -tzip " _ & ZipDest & " " & strFileFix, vbNormalFocus) End If End If Next file End If End If Next rngID strMsgEnd = "Files have been updated" If bZip = True Then strMsgEnd = strMsgEnd & vbCrLf _ & "Zipped files have been created" End If MsgBox strMsgEnd exitHandler: Application.ScreenUpdating = True Application.DisplayAlerts = True Exit Sub errHandler: MsgBox "Could not update the files" Resume exitHandler End Sub
First, the code shows a message that asks if you want to update the files. If you do not click Yes, the code stops running.
lUpdate = MsgBox("Update all files?", _ vbYesNo + vbDefaultButton2, "Update All?") If lUpdate <> vbYes Then GoTo exitHandler
Then, it gets the specifications that you entered on the Setup sheet, and checks if Zip files should be created.
Select Case wsFL.Range("rngZip").Valu
Next, it check the ID number entered on the Setup sheet. If that cell is blank, it will run the macro for every folder in the list..
For Each rngID In rngFLID If lFldr = 0 Then bRun = rngID > 0 Else bRun = rngID = lFldr End If If bRun = True Then
For each folder, it opens each file that has "xls" in its name, and the UpdateLinks setting is turned off (false).
Workbooks.Open strFileFix, False
The master sheet is updated or replaced, if names were added, they are deleted, and the file is closed, with the changes saved.
wb.Close SaveChanges:=True
If the Zip setting is "Yes", double quotes are added around the file names, to prevent problems if there are spaces in the names or paths.
If bZip = True Then ZipDest = Chr(34) & ZipDestPath & _ Left(strFile, InStr(1, strFile, strFileTest)) _ & "zip" & Chr(34) strFileFix = Chr(34) & strFileFix & Chr(34
Finally, a zipped file is created. This is the Shell command used when working with the 7-zip program -- other zip programs will be slightly different.
ZipFile = Shell(ZipPath & "7zG.exe a -tzip " _ & ZipDest & " " & strFileFix, vbNormalFocus) End If
To download the sample file, click here: Update and Zip an Excel Workbook.
The file is in xlsm format, and contains macros. Enable macros when you open the file, if you want to test the code.
Create an Excel UserForm Video
Excel VBA Edit Your Recorded Macro
Last updated: March 9, 2023 4:22 PM