Hi,
I have been trying to get some code to recurse through a directory starting from a fixed folder, and then create a table of hyperlinks to all docs found.
I am sure I saw some code like this either here or in the 'old' woodys lounge'. Does it ring a bell with anyone?
Recurse a directory and create hyperlinks
-
- StarLounger
- Posts: 71
- Joined: 20 Feb 2010, 10:31
- Location: UK
Recurse a directory and create hyperlinks
thanks, Paul.
-
- PlutoniumLounger
- Posts: 15647
- Joined: 24 Jan 2010, 23:23
- Location: brings.slot.perky
Re: Recurse a directory and create hyperlinks
How close is this?pmatz wrote:I have been trying to get some code to recurse through a directory starting from a fixed folder, and then create a table of hyperlinks to all docs found.
What this application does for you
This application generates a set of hyper linked documents that represent a folder or a folder structure.
If you inherit a project with documents scattered throughout a hard drive, this tool can help you navigate through those documents.
In particular if you use a tool like Web-Word (http://www.chrisgreaves.com" onclick="window.open(this.href);return false;) to process all linked documents in a set – any set – Hyper will give you a fast-start in building that set.
One-click use
After installing the application template Hyper.dot, load Word and choose the BuildHyperlink macro from the Hyperlink toolbar menu.
Hyper will build documents with extensions *.HYP, each of which contains a map of a folder.
Code: Select all
' Given an absolute path
' 1) Ensure that Path\Path.HYP exists as a signed document
' 2) Build a table of local directories
' 3) For each local directory recurse to this procedure
' 4) Load hyperlinks to each local directory HYP
' 5) Load hyperlinks to each local DOCument.
' 6) Return the name for this Hyperdocument (for this directory)
He who plants a seed, plants life.
-
- StarLounger
- Posts: 71
- Joined: 20 Feb 2010, 10:31
- Location: UK
Re: Recurse a directory and create hyperlinks
Hi Chris.
Sounds like you have hit the nail on the head. Had a look at your site bu tcouldn't find the Hyper.dot anywhere. am i missing something/
Sounds like you have hit the nail on the head. Had a look at your site bu tcouldn't find the Hyper.dot anywhere. am i missing something/
thanks, Paul.
-
- Administrator
- Posts: 78608
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: Recurse a directory and create hyperlinks
Try this:
Code: Select all
' Module-level collection to store all subfolder names in
Dim colFolders As Collection
Sub Test()
Dim varItem As Variant
Dim strFile As String
Dim rng As Range
' Initialize colFolders
Set colFolders = New Collection
' Add all subfolders of C:MyFiles to colFolders
RecurseFolders "H:"
For Each varItem In colFolders
If Not Right(varItem, 1) = "\" Then
varItem = varItem & "\"
End If
strFile = Dir(varItem & "*.doc*")
Do While strFile <> ""
Set rng = ActiveDocument.Content
rng.Collapse Direction:=wdCollapseEnd
ActiveDocument.Hyperlinks.Add Anchor:=rng, Address:=varItem & strFile
rng.InsertParagraphAfter
strFile = Dir
Loop
Next varItem
End Sub
Sub RecurseFolders(ByVal strPath As String)
Dim colSubFolders As New Collection
Dim strSubFolder As String
Dim varItem As Variant
If Not Right(strPath, 1) = "\" Then
strPath = strPath & "\"
End If
strSubFolder = Dir(strPath, vbDirectory)
Do Until strSubFolder = ""
If strSubFolder <> "." And strSubFolder <> ".." Then
If GetAttr(strPath & strSubFolder) And vbDirectory Then
' Add to both local and global collections
colFolders.Add strPath & strSubFolder
colSubFolders.Add strSubFolder
End If
End If
strSubFolder = Dir
Loop
For Each varItem In colSubFolders
RecurseFolders strPath & varItem
Next varItem
End Sub
Best wishes,
Hans
Hans
-
- StarLounger
- Posts: 71
- Joined: 20 Feb 2010, 10:31
- Location: UK
Re: Recurse a directory and create hyperlinks
Thanks Hans
this works wonderuflly! Thanks.
I had to add the declaration for colFolders at the global level, and also change
If Not Right(strPath, 1) = "" Then
strPath = strPath & ""
to If Not Right(strPath, 1) = "\" Then
strPath = strPath & "\"
to stop it crashing.
debugged code:
this works wonderuflly! Thanks.
I had to add the declaration for colFolders at the global level, and also change
If Not Right(strPath, 1) = "" Then
strPath = strPath & ""
to If Not Right(strPath, 1) = "\" Then
strPath = strPath & "\"
to stop it crashing.
debugged code:
Code: Select all
Dim colFolders As New Collection
Sub Test()
Dim varItem As Variant
Dim strFile As String
Dim rng As Range
' Initialize colFolders
Set colFolders = New Collection
' Add all subfolders of C:MyFiles to colFolders
RecurseFolders "H:"
For Each varItem In colFolders
If Not Right(varItem, 1) = "\" Then
varItem = varItem & "\"
End If
strFile = Dir(varItem & "*.doc*")
Do While strFile <> ""
Set rng = ActiveDocument.Content
rng.Collapse Direction:=wdCollapseEnd
ActiveDocument.Hyperlinks.Add Anchor:=rng, Address:=varItem & strFile
rng.InsertParagraphAfter
strFile = Dir
Loop
Next varItem
End Sub
Sub RecurseFolders(ByVal strPath As String)
Dim colSubFolders As New Collection
Dim strSubFolder As String
Dim varItem As Variant
If Not Right(strPath, 1) = "\" Then
strPath = strPath & "\"
End If
strSubFolder = Dir(strPath, vbDirectory)
Do Until strSubFolder = ""
If strSubFolder <> "." And strSubFolder <> ".." Then
If GetAttr(strPath & strSubFolder) And vbDirectory Then
' Add to both local and global collections
colFolders.Add strPath & strSubFolder
colSubFolders.Add strSubFolder
End If
End If
strSubFolder = Dir
Loop
For Each varItem In colSubFolders
RecurseFolders strPath & varItem
Next varItem
End Sub
thanks, Paul.
-
- Administrator
- Posts: 78608
- Joined: 16 Jan 2010, 00:14
- Status: Microsoft MVP
- Location: Wageningen, The Netherlands
Re: Recurse a directory and create hyperlinks
I don't understand - the code that I posted does declare colFolders at the top, and does have strPath = strPath & "\".
(The original version in the Windows Secrets Lounge is messed up)
(The original version in the Windows Secrets Lounge is messed up)
Best wishes,
Hans
Hans
-
- StarLounger
- Posts: 71
- Joined: 20 Feb 2010, 10:31
- Location: UK
Re: Recurse a directory and create hyperlinks
Thats true.
Perhaps you updated it after I copied,,, or I'm copying it like a lemon!!! Sorry mate, and thanks again.
Perhaps you updated it after I copied,,, or I'm copying it like a lemon!!! Sorry mate, and thanks again.
thanks, Paul.
-
- PlutoniumLounger
- Posts: 15647
- Joined: 24 Jan 2010, 23:23
- Location: brings.slot.perky
Re: Recurse a directory and create hyperlinks
Yup. The sinus infection I've got.pmatz wrote: am i missing something/
Sorry about that.
If you go to http://www.chrisgreaves.com/downloads/ which is my work-in-progress new downloads page you should see a link for Hyper050.zip.
I wrote the initial version 15 years ago merely to provide input to my web compiler WbWrd.
It may be overkill for your needs; I see that Hans has come up with an almost-one-liner by comparison.
He who plants a seed, plants life.
-
- StarLounger
- Posts: 71
- Joined: 20 Feb 2010, 10:31
- Location: UK
Re: Recurse a directory and create hyperlinks
Thanks both, and I appreciate the link Chris, will use that aswell as I am building something to format a directory of links in a word doc, so with the starting point from Hans and also looking at the Hyper.dot I should be well on my way.
In word I always take a while to remember how to navigate the selection as most of my vba is in excel these days...
hope you can breathe again soon!
In word I always take a while to remember how to navigate the selection as most of my vba is in excel these days...
hope you can breathe again soon!
thanks, Paul.