![]() |
hyperlinks to files in all sub-directories
Hi,
I searched the newsgroup and found some code that gives me hyperlinks to files in a directory. In addition to linking to files in the directory, is it possible to link to files in all of the sub-folders of the directory? For instance, if I have a folder C:\Steve\ with several files and some sub folders (C:\Steve\Folder1\ and C:\Steve\Folder2\ etc.) each with several files, I want to be able to run a macro that would make links to all the files just by inputting the first directory C:\Steve\. Is this possible? Ideally, I would like a new worksheet for each folder having the same name as that folder, but this is more of a bonus. The part above is what I really need. Here is the code I have so far (thanks to Bill Manville): Sub HyperlinksToDirectory() ' puts hyperlinks to each of the files in a directory of your choice ' into the active sheet starting at the active cell Dim stDir As String Dim stFile As String Dim R As Range Set R = ActiveCell stDir = InputBox("Directory?", , Default:=CurDir()) stFile = Dir(stDir & "\*.*") Do Until stFile = "" R.Hyperlinks.Add R, stDir & "\" & stFile, , , stFile Set R = R.Offset(1) stFile = Dir() Loop End Sub Thanks, Steve Mackay |
hyperlinks to files in all sub-directories
Thanks, Jim. I think I found the answer to my own question in another
posting. If any one is interested, here is the code. I don't like that it displays the whole directory tree, I would like to just display the filename. Not sure how to change that, but I can use a formula to extract just the name. Thanks to whomever posted this: Option Explicit Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _ Alias "SHGetPathFromIDListA" _ (ByVal pidl As Long, _ ByVal pszPath As String) As Long Private Declare Function SHBrowseForFolder Lib "shell32.dll" _ Alias "SHBrowseForFolderA" _ (lpBrowseInfo As BROWSEINFO) As Long Private Type BROWSEINFO hOwner As Long pidlRoot As Long pszDisplayName As String lpszTitle As String ulFlags As Long lpfn As Long lParam As Long iImage As Long End Type Dim FSO As Object Dim cnt As Long Dim level As Long Dim arFiles Sub ListFiles() Dim i As Long Dim sFolder As String Application.Calculation = xlCalculationManual Set FSO = CreateObject("Scripting.FileSystemObject") arFiles = Array() cnt = -1 level = 1 sFolder = GetFolder() ReDim arFiles(1, 0) If sFolder < "" Then SelectFiles sFolder Worksheets.Add.Name = "Files" With ActiveSheet For i = LBound(arFiles, 2) To UBound(arFiles, 2) .Hyperlinks.Add Anchor:=.Cells(i + 1, arFiles(1, 0)), _ Address:=arFiles(0, i), _ TextToDisplay:=arFiles(0, i) Next End With End If Application.Calculation = xlCalculationAutomatic End Sub Thanks, Steve Mackay |
All times are GMT +1. The time now is 07:59 PM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com