pull links for all files in folder AND subfolder

so I have code that is pulling the links for all files in a folder but I need it to pull for all sub folders as well. the output is going into column a and I would like for it to overwrite anything that is there already. the code I have so far is:

Sub Hyperlinkpuller()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer

'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")

'Get the folder object
Set objFolder = objFSO.GetFolder("c:\users\")
i = 1

'loops through each file in the directory
For Each objFile In objFolder.Files
    
    'select cell
    Range(Cells(i + 1, 1), Cells(i + 1, 1)).Select
    
    'create hyperlink in selected cell
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
        objFile.Path, _
        TextToDisplay:=objFile.Path
    i = i + 1
Next objFile
End Sub

Open in new window

david franciscoAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

ShumsDistinguished Expert - 2017Commented:
Hi Try below:
Sub Hyperlinkpuller()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer

'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")

'Get the folder object
Set objFolder = objFSO.GetFolder("c:\users\")
i = 1

'loops through each file in the directory
For Each objFile In objFolder.Files
    
    'select cell
    Range(Cells(i + 1, 1), Cells(i + 1, 1)).Select
    
    'create hyperlink in selected cell
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
        objFile.Path, _
        TextToDisplay:=objFile.Path &  "\"
    i = i + 1
Next objFile
End Sub

Open in new window

0
david franciscoAuthor Commented:
I see no difference in output from the original code I submitted. to clarify I got the code to loop through the first level of subfolders, but the loop will not go deeper than 1 level.
Sub Hyperlinkpuller()
Dim objFSO As Object, objFolder As Object, objSubfolder As Object, objFile As Object
Dim i As Integer
'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set objFolder = objFSO.GetFolder("c:\users\")
i = 1
'loops through each file in the directory
For Each objSubfolder In objFolder.subfolders

For Each objFile In objSubfolder.Files
    'select cell
    Range(Cells(i + 1, 1), Cells(i + 1, 1)).Select
    'create hyperlink in selected cell
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:= _
        objFile.Path, _
        TextToDisplay:=objFile.Path
    i = i + 1
Next objFile
Next objSubfolder
End Sub

Open in new window


there must be something that will make it loop through ALL subfolders in the file tree, not just 1 level down.
0
aikimarkCommented:
Instead of using FSO for folder and file iteration, you could shell out a command that does a Dir c:\users /a-d /b /s > c:\temp\dirlist.txt of the parent folder, directing the output to another file.  Then you can read the contents of the dirlist.txt file and populate the worksheet hyperlinks.
0
Big Business Goals? Which KPIs Will Help You

The most successful MSPs rely on metrics – known as key performance indicators (KPIs) – for making informed decisions that help their businesses thrive, rather than just survive. This eBook provides an overview of the most important KPIs used by top MSPs.

david franciscoAuthor Commented:
is that using excel vba? im confused. I have no access to shell or cmd.
0
ShumsDistinguished Expert - 2017Commented:
Another approach would be:
Option Compare Text
Option Explicit
 
Function Excludes(Ext As String) As Boolean
     'Function purpose:  To exclude listed file extensions from hyperlink listing
     
    Dim X, NumPos As Long
     
     'Enter/adjust file extensions to EXCLUDE from listing here:
    X = Array("exe", "bat", "dll", "zip")
     
    On Error Resume Next
    NumPos = Application.WorksheetFunction.Match(Ext, X, 0)
    If NumPos > 0 Then Excludes = True
    On Error GoTo 0
     
End Function
 
Sub HyperlinkFileList()
     'Macro purpose:  To create a hyperlinked list of all files in a user
     'specified directory, including file size and date last modified
     'NOTE:  The 'TextToDisplay' property (of the Hyperlink object) was added
     'in Excel 2000.  This code tests the Excel version and does not use the
     'Texttodisplay property if using XL 97.
     
    Dim fso As Object, _
    ShellApp As Object, _
    File As Object, _
    SubFolder As Object, _
    Directory As String, _
    Problem As Boolean, _
    ExcelVer As Integer
     
     'Turn off screen flashing
    Application.ScreenUpdating = False
     
     'Create objects to get a listing of all files in the directory
    Set fso = CreateObject("Scripting.FileSystemObject")
     
     'Prompt user to select a directory
    Do
        Problem = False
        Set ShellApp = CreateObject("Shell.Application"). _
        Browseforfolder(0, "Please choose a folder", 0, "c:\users\")
         
        On Error Resume Next
         'Evaluate if directory is valid
        Directory = ShellApp.self.Path
        Set SubFolder = fso.GetFolder(Directory).Files
        If Err.Number <> 0 Then
            If MsgBox("You did not choose a valid directory!" & vbCrLf & _
            "Would you like to try again?", vbYesNoCancel, _
            "Directory Required") <> vbYes Then Exit Sub
            Problem = True
        End If
        On Error GoTo 0
    Loop Until Problem = False
     
     'Set up the headers on the worksheet
    With ActiveSheet
        With .Range("A1")
            .Value = "Listing of all files in:"
            .ColumnWidth = 40
             'If Excel 2000 or greater, add hyperlink with file name
             'displayed.  If earlier, add hyperlink with full path displayed
            If Val(Application.Version) > 8 Then 'Using XL2000+
                .Parent.Hyperlinks.Add _
                Anchor:=.Offset(0, 1), _
                Address:=Directory, _
                TextToDisplay:=Directory
            Else 'Using XL97
                .Parent.Hyperlinks.Add _
                Anchor:=.Offset(0, 1), _
                Address:=Directory
            End If
        End With
        With .Range("A2")
            .Value = "File Name"
            .Interior.ColorIndex = 15
            With .Offset(0, 1)
                .ColumnWidth = 15
                .Value = "Date Modified"
                .Interior.ColorIndex = 15
                .HorizontalAlignment = xlCenter
            End With
            With .Offset(0, 2)
                .ColumnWidth = 15
                .Value = "File Size (Kb)"
                .Interior.ColorIndex = 15
                .HorizontalAlignment = xlCenter
            End With
        End With
    End With
     
     'Adds each file, details and hyperlinks to the list
    For Each File In SubFolder
        If Not Excludes(Right(File.Path, 3)) = True Then
            With ActiveSheet
                 'If Excel 2000 or greater, add hyperlink with file name
                 'displayed.  If earlier, add hyperlink with full path displayed
                If Val(Application.Version) > 8 Then 'Using XL2000+
                    .Hyperlinks.Add _
                    Anchor:=ActiveSheet.Range("A65536").End(xlUp).Offset(1, 0), _
                    Address:=File.Path, _
                    TextToDisplay:=File.Name
                Else 'Using XL97
                    .Hyperlinks.Add _
                    Anchor:=ActiveSheet.Range("A65536").End(xlUp).Offset(1, 0), _
                    Address:=File.Path
                End If
                 'Add date last modified, and size in KB
                With .Range("A65536").End(xlUp)
                    .Offset(0, 1) = File.datelastModified
                    With .Offset(0, 2)
                        .Value = WorksheetFunction.Round(File.Size / 1024, 1)
                        .NumberFormat = "#,##0.0"
                    End With
                End With
            End With
        End If
    Next
     
End Sub

Open in new window

Source from Create Hyperlinked List of Directory Contents
0
aikimarkCommented:
set oWSH = createobject("wscript.shell")
oWSH.Run "cmd.exe Dir c:\users /a-d /b /s > c:\temp\dirlist.txt", 0, True

Open in new window

0
david franciscoAuthor Commented:
yeah that will not work for me, i have zero access to the shell and cmd at my location,
0
aikimarkCommented:
What happens when you execute those two statements?
0
aikimarkCommented:
Note: the cmd.exe needs a /C switch.  This should go before the Dir command
0
Bill PrewCommented:
Give this a try, it will recursively drill into all subfolders of the starting folder.

Sub Hyperlinkpuller()
    Dim objFSO As Object
    Dim i As Integer

    'Create an instance of the FileSystemObject
    Set objFSO = CreateObject("Scripting.FileSystemObject")

    'Get the folder object
    i = 1
    Call ProcessFolder(objFSO.GetFolder("c:\temp\"))

End Sub

Sub ProcessFolder(objFolder As Object)
    Dim objFile As Object
    Dim objSubFolder As Object
    
    'loops through each file in the directory
    For Each objFile In objFolder.Files
    
        'select cell
        Range(Cells(i + 1, 1), Cells(i + 1, 1)).Select
    
        'create hyperlink in selected cell
        ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=objFile.Path, TextToDisplay:=objFile.Path
        i = i + 1
    Next objFile

    For Each objSubFolder In objFolder.SubFolders
        Call ProcessFolder(objSubFolder)
    Next objSubFolder

End Sub

Open in new window

~bp
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
david franciscoAuthor Commented:
Thanks Bill, it looks like that code is working, the only thing it is not doing is moving beyond cell A293, and if there are more cells, it is overwriting what is existing. is there any way it would insert the links of all files and not just overwrite what is there unless you run the hyperlinkpuller sub?
0
Bill PrewCommented:
There is nothing in the code that stops before gathering all files.  I ran a test here and got over 2600 rows, all the files in the tree I started it from.  Perhaps you are hitting files you don't have access to?

Not sure I understand the rest of your question, I would think you would want to clear the whole column A before starting, but since that wasn't in your original code i didn't add it - "it's left to the student"...

~bp
0
david franciscoAuthor Commented:
i made some edits to the code, and it works by having the code changed to
Sub Hyperlinkpuller()
    Dim objFSO As Object
    Dim i As Integer

    'Create an instance of the FileSystemObject
    Set objFSO = CreateObject("Scripting.FileSystemObject")

    'Get the folder object
    i = 1
    Call ProcessFolder(objFSO.GetFolder("L:\Global Expert\Buddy"))

End Sub

Sub ProcessFolder(objFolder As Object)
    Dim objFile As Object
    Dim objSubFolder As Object
    
    'loops through each file in the directory
    For Each objFile In objFolder.Files
    
        'select cell
        Range("A" & Rows.Count).End(xlUp).Offset(1).Select
    
        'create hyperlink in selected cell
        ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=objFile.Path, TextToDisplay:=objFile.Path
        i = i + 1
    Next objFile

    For Each objSubFolder In objFolder.SubFolders
        Call ProcessFolder(objSubFolder)
    Next objSubFolder

End Sub

Open in new window


thanks for all the help!
0
Bill PrewCommented:
You can remove the i  variable using that approach, and all it's usages.

~bp
0
aikimarkCommented:
Note: Integer variables have a 32K max value.
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Office

From novice to tech pro — start learning today.