How to Create folders with hyperlink from Excel Macro

I've previously shared how to automatically create folders from an Excel spreadsheet by using a macro. I recently had a reader request an additional feature: to automatically add a hyperlink from the Excel sheet to the newly created folders. I not only added this ability to my code, I also improved the overall code some as well.

The steps to use this macro to create folders is as follows:

1. User selects range of cells they want to turn into folders
2. Run macro
3. Select location where folders will be created
4. Macro automatically creates folders and hyperlinks selected cell to newly created folder

Here is a screen capture video of the VBA in action:


You can download the exact same spreadsheet template I use in the video here.

Or you can copy and paste the code below into your own Excel file. I use comments to explain what us happening on each line of code.

Sub Create_Folders()

'remember to select the cells you want to turn into folders before running the macro

'Default location where to select folder

Dim OpenAt As String

OpenAt = "My computer:\"

'Dialog box to select folder creation location

Set ShellApp = CreateObject("Shell.Application").BrowseForFolder(0, "Please Choose The Folder For This Project", 0, OpenAt)

'Set the folder to that selected. (On error in case cancelled)

On Error Resume Next

BrowseForFolder = ShellApp.Self.Path

'get the range of cells that were selected before the macro was run

Dim Rng As Range

Dim maxRows, maxCols, r, c As Integer

Set Rng = Selection

maxRows = Rng.Rows.Count

maxCols = Rng.Columns.Count

'---loop through all cells within selected range---

For c = 1 To maxCols

   r = 1

   Do While r <= maxRows

  

       'if the selected cell does not contain nothing, then create a folder

       If Rng(r, c) <> "" Then

           'create hyperlink in Excel file to newly created folder

           Dim cnf

           Set cnf = CreateObject("Scripting.FileSystemObject")

               'If folder already exists in this location, then just create hyperlink in Excel

               If (cnf.FolderExists(BrowseForFolder & "\" & Rng(r, c))) Then

       

               'MsgBox "folder does  already exist"

              ActiveSheet.Hyperlinks.Add Anchor:=Rng(r, c), Address:=BrowseForFolder & "\" & Rng(r, c)

   

               'if folder does not previously exist, then we need to create it and add hyperlink

               Else

               'MsgBox "need to create folder"

               cnf.CreateFolder (BrowseForFolder & "\" & Rng(r, c))

              ActiveSheet.Hyperlinks.Add Anchor:=Rng(r, c), Address:=BrowseForFolder & "\" & Rng(r, c)

               End If

           On Error Resume Next

   

       'if the selected cell contains nothing, then do nothing and go to the next cell

       End If

      

       r = r + 1

       Loop

   Next c

End Sub

Follow my Excel Help playlist for more how to videos in the future.