Contextures

Home > Macros > Basics > Zip Files

Update and Zip Excel Files

Use 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.

assign macro to button

Introduction

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 Master Sheet

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.

button to update files

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:

  • Named ranges
  • Formulas that refer to other sheets or files
  • Links to other files

The Setup Sheet

File Specifications

On the Setup sheet, fill in the orange cells, with your file information and preferences.

  1. The code in the sample file uses the 7-Zip program, which is a free download. The first orange cell is the path to that program.
  2. Next, enter the folder number, based on the list of folders that you entered. In the screen shot below, the files in the 2nd folder will be updated. NOTE: You can leave that cell blank, to update files in all the folders
  3. In the Sheet to Copy cell, enter the name of your Master sheet -- ContactInfo in this example.
  4. After updating the files, the code can also zip the files, and store them in a different folder. If you don't need that option, select No from the drop down list.

setup sheet with cells to fill in

File Locations

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.

folder list  to update files

Make a Backup

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.

make a backup before updating files

Update Button

On the Setup sheet, there is a button to run the Update macro.

  • The button caption will be "Update Files", if the Zip Files option is set as "No"
  • If "Yes" is selected, the caption will be "Update & Zip Files"

To create the button:

  • Draw a rounded rectangle on the worksheet
  • Use the Shape Styles, to format it to look like a clickable button

    format the shape

To create the button caption:

  • Enter this formula in cell D15:

="Update" & IF(rngZip="Yes"," & Zip","") & " Files"

format the shape

Select the button shape

Click in the formula bar, and type this formula:

=$D$15

button formula to update files

Update Macro

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.

  • Right-click on the button
  • Click Assign Macro
  • Select the UpdateContactSheet macro

    assign macro to 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

How the Macro Works

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

Download the Sample File

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.

Related Excel VBA Tutorials

FAQs, Excel VBA, Excel Macros  

Create an Excel UserForm   Video

UserForm with ComboBoxes

Excel VBA Edit Your Recorded Macro

Excel VBA Getting Started  

 

 

 

 

About Debra

 

 

Last updated: March 9, 2023 4:22 PM