Wednesday, May 18, 2016

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.