We help IT Professionals succeed at work.

pull links for all files in folder AND subfolder

221 Views
Last Modified: 2017-03-31
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

Comment
Watch Question

ShumsManaging Director/Excel VBA Developer
CERTIFIED EXPERT
Distinguished Expert 2018
Commented:
This problem has been solved!
(Unlock this solution with a 7-day Free Trial)
UNLOCK SOLUTION

Author

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.
aikimarkSocial distance; Wear a mask; Don't touch your face; Wash your hands for 20 seconds
CERTIFIED EXPERT
Top Expert 2014

Commented:
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.

Author

Commented:
is that using excel vba? im confused. I have no access to shell or cmd.
ShumsManaging Director/Excel VBA Developer
CERTIFIED EXPERT
Distinguished Expert 2018
Commented:
This problem has been solved!
(Unlock this solution with a 7-day Free Trial)
UNLOCK SOLUTION
aikimarkSocial distance; Wear a mask; Don't touch your face; Wash your hands for 20 seconds
CERTIFIED EXPERT
Top Expert 2014

Commented:
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

Author

Commented:
yeah that will not work for me, i have zero access to the shell and cmd at my location,
aikimarkSocial distance; Wear a mask; Don't touch your face; Wash your hands for 20 seconds
CERTIFIED EXPERT
Top Expert 2014

Commented:
What happens when you execute those two statements?
aikimarkSocial distance; Wear a mask; Don't touch your face; Wash your hands for 20 seconds
CERTIFIED EXPERT
Top Expert 2014

Commented:
Note: the cmd.exe needs a /C switch.  This should go before the Dir command
Test your restores, not your backups...
CERTIFIED EXPERT
Expert of the Year 2019
Top Expert 2016
Commented:
This problem has been solved!
(Unlock this solution with a 7-day Free Trial)
UNLOCK SOLUTION

Author

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?
Bill PrewTest your restores, not your backups...
CERTIFIED EXPERT
Expert of the Year 2019
Top Expert 2016
Commented:
This problem has been solved!
(Unlock this solution with a 7-day Free Trial)
UNLOCK SOLUTION

Author

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!
Bill PrewTest your restores, not your backups...
CERTIFIED EXPERT
Expert of the Year 2019
Top Expert 2016

Commented:
You can remove the i  variable using that approach, and all it's usages.

~bp
aikimarkSocial distance; Wear a mask; Don't touch your face; Wash your hands for 20 seconds
CERTIFIED EXPERT
Top Expert 2014

Commented:
Note: Integer variables have a 32K max value.

Gain unlimited access to on-demand training courses with an Experts Exchange subscription.

Get Access
Why Experts Exchange?

Experts Exchange always has the answer, or at the least points me in the correct direction! It is like having another employee that is extremely experienced.

Jim Murphy
Programmer at Smart IT Solutions

When asked, what has been your best career decision?

Deciding to stick with EE.

Mohamed Asif
Technical Department Head

Being involved with EE helped me to grow personally and professionally.

Carl Webster
CTP, Sr Infrastructure Consultant
Empower Your Career
Did You Know?

We've partnered with two important charities to provide clean water and computer science education to those who need it most. READ MORE

Ask ANY Question

Connect with Certified Experts to gain insight and support on specific technology challenges including:

  • Troubleshooting
  • Research
  • Professional Opinions