Recurse a directory and create hyperlinks

[pmatz]

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?

[ChrisGreaves]

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.

How close is this?

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)

[pmatz]

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/

[HansV]

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

[pmatz]

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:

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

[HansV]

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)

[pmatz]

Thats true.

Perhaps you updated it after I copied,,, or I'm copying it like a lemon!!! Sorry mate, and thanks again.

[ChrisGreaves]

am i missing something/

Yup. The sinus infection I've got.
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.

[pmatz]

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!