Solved: Add hyperlinks at end of document

[mdmackillop]

I'm putting together some code to copy the first paragraphs from a folder of documents, and insert them in a new document, heading each with a hyperlink to the original. I'm stuck with getting the Range code to add the hyperlink at the end of the document in each loop (the code in the astersisks)
Sub GetList2()
Dim MyDoc As Document, MyFile As String, Location As String
Dim Source As Document, Tmp

Set MyDoc = ActiveDocument
ActiveDocument.Range.Delete

Location = "G:\NBS\Minor\"
MyFile = Dir(Location & "*.DOC")
If MyFile = "" Then Exit Sub
ChangeFileOpenDirectory Location

MyDoc.Range.InsertAfter Location & vbCr & vbCr

Do
If MyFile <> MyDoc.Name Then
Set Source = Documents.Open(FileName:=MyFile, Visible:=False)
Tmp = Source.Range(Source.Paragraphs(1).Range.Start, Source.Paragraphs(5).Range.End)
Source.Close
'******************************************
With MyDoc.Range
.Collapse wdCollapseEnd
.Hyperlinks.Add Anchor:=Selection.Range, _
Address:=Location & MyFile, TextToDisplay:=MyFile
End With
'*******************************************
txt = txt & vbCr & Tmp & vbCr
MyDoc.Range.InsertAfter txt

End If
MyFile = Dir
Loop Until MyFile = ""
End Sub

[R_Rajesh]

Try this


Sub GetList2()
Dim MyDoc As Document, MyFile As String, Location As String
Dim Source As Document, Tmp

Set MyDoc = ActiveDocument
ActiveDocument.Range.Delete

Location = "G:\NBS\Minor\"
MyFile = Dir(Location & "*.DOC")
If MyFile = "" Then Exit Sub
ChangeFileOpenDirectory Location

MyDoc.Range.InsertAfter Location & vbCr & vbCr

Do
If MyFile <> MyDoc.Name Then
Set Source = Documents.Open(FileName:=MyFile, Visible:=False)
Tmp = Source.Range(Source.Paragraphs(1).Range.Start, Source.Paragraphs(5).Range.End)
Source.Close
'******************************************
'With MyDoc.Range
' .Collapse wdCollapseEnd
MyDoc.Hyperlinks.Add Anchor:=MyDoc.Bookmarks("\EndOfDoc").Range, _
Address:=Location & MyFile, TextToDisplay:=CStr(MyFile)
'End With
'*******************************************
txt = vbCr & Tmp & vbCr
MyDoc.Range.InsertAfter txt

End If
MyFile = Dir
Loop Until MyFile = ""
End Sub

[mdmackillop]

Thanks very much. Exactly what I was looking for. I've not come across Predefined Bookmarks before. I think they could be very useful.
Still busy at EE?
Regards
Malcolm

[R_Rajesh]

Hi Malcolm,
Yeh they do come in handy. I visit EE mainly to keep up the premium. Somehow it isn't as fun as it used to be...

[mdmackillop]

I rarely visit now, although I see I've just been awarded a tee shirt!
This site is much more friendly and cooperative, with no rush to be the first responder.
I'm trying to get a better handle on Ranges etc. in Word so that Gerry (Fumei) doesn't jump on my replies! Thanks again for the assist.

[fumei]

I don't know whether to feel complimented, or insulted.

Neither really. Just kidding.

Yes Malcolm, the predefined bookmarks are VERY handy.

You may recall some post recently about getting the current page. lucas (Steve) used Selection - and you know how I feel about Selection. Selection of a predefined bookmark ("\page"), but nevetheless the Selection was used to GoTo it, and copy. Rather than just setting a Range for the thing itself.

Bookmarks are defined ranges. Predefined bookmarks are "pre"defined ranges. This is actually a misnomer, technically. As "\page" (for example) has to be, in fact, calculated every time it is used. So it is not fully predefined. Its parameters are, but its values are not.

When looking at the Help on predefined bookmarks, be SURE you read and understand what it does with the following (terminating) paragraph mark, or section mark. This is crucial!

Often that trailing mark is NOT what you want included, so when making a range (as you will be using a range for this most often), you need to use .MoveEnd to nudge the Range end back a bit.

Further comments:

You use: Set MyDoc = ActiveDocument
ActiveDocument.Range.Delete Interesting. You Set MyDoc to be the active document...then use ActiveDocument.

Here is a possible alternative that may assist in what you are doing. I have removed the grabbing of the first 5 paragraphs - since that is not relevant to demonstating process.

This uses Filesearch.Sub ListFilesHyperlink(strIn As String)
Dim ThisDoc As Document
Dim Source As Document
Dim NumberFiles As Long
Dim StartLocation As String
Dim var

Set ThisDoc = ActiveDocument
ThisDoc.Range.Delete

StartLocation = "c:\test\"

ThisDoc.Range.InsertAfter "Starting folder: " & _
StartLocation & vbCr & vbCr

With Application.FileSearch
.NewSearch
.LookIn = StartLocation
.FileName = "*.doc"
.FileType = msoFileTypeAllFiles
.SearchSubFolders = True
.TextOrProperty = strIn
End With

NumberFiles = Application.FileSearch.Execute()
For var = 1 To NumberFiles
Set Source = Documents.Open _
(FileName:=Application.FileSearch.FoundFiles(var), _
Visible:=False)

ThisDoc.Hyperlinks.Add _
Anchor:=ThisDoc.Bookmarks("\EndOfDoc").Range, _
Address:=Application.FileSearch.FoundFiles(var), _
TextToDisplay:=Source.Name
ThisDoc.Range.InsertAfter Text:=vbCrLf & vbCrLf
Source.Close
Next
End SubNote that this will get the files out of any subfolders. It builds the Hyperlink address from the FoundFiles collection. The collection of FoundFiles (used to open the files) is the full path.

The TextToDisplay is the .Name of each file opened.

This used a hardcoded starting folder, but you could easily adjust that to take a parameter.

Sub ListFilesHyperlink(strFolder As String, strIn As String)then call it:
Sub GetStuff()
Call ListFilesHyperlink("c:\", "Malcom")
End Subwhich would create a document with hyperlinks to every .doc file that contains "Malcolm" on your C: drive.

[fumei]

Oh, and if you were just trying to collect the names of file (and make hyperlinks to them) that contain specified text, but NOT actually open them, this can also be done.

Obviously if there is no need to open the files, this cuts down A LOT on processing and overhead.Sub Yabbadadda(strIn As String)
Dim ThisDoc As Document
Dim NumberFiles As Long
Dim StartLocation As String

Dim var
Dim j As Long

Set ThisDoc = ActiveDocument
ThisDoc.Range.Delete

StartLocation = "c:\test\"

ThisDoc.Range.InsertAfter "Starting folder: " & _
StartLocation & vbCr & vbCr

With Application.FileSearch
.NewSearch
.LookIn = StartLocation
.FileName = "*.doc"
.FileType = msoFileTypeAllFiles
.SearchSubFolders = True
.TextOrProperty = strIn
End With

NumberFiles = Application.FileSearch.Execute()
For var = 1 To NumberFiles
FoundFile = Application.FileSearch.FoundFiles(var)
FoundFile = StrReverse(FoundFile)
j = InStr(FoundFile, Application.PathSeparator)
FoundFile = StrReverse(Left(FoundFile, j - 1))

ThisDoc.Hyperlinks.Add _
Anchor:=ThisDoc.Bookmarks("\EndOfDoc").Range, _
Address:=Application.FileSearch.FoundFiles(var), _
TextToDisplay:=FoundFile
ThisDoc.Range.InsertAfter Text:=vbCrLf & vbCrLf
Next
Set ThisDoc = NothingWill compile a document with hyperlinks to all doc files containing the input string. No document file is ever opened.

So again, if no text is required to be extracted from the documents, this is MUCH faster.

[mdmackillop]

Thanks Gerry,
I'll digest this later.

[fumei]

Just for interest sake, some numbers.

Ran the code above with the search string as "Gerry"

Number of files searched: 2,351
Number of files with search string: 1,579

Time to write the file with 1,579 hyperlinks to the files: 1m 25s

Time to determine the total files (2,351) without writing the hyperlinks: 0m 2s

[mdmackillop]

Hi Gerry,
Thanks for the response. In this case, I don't need to find anything, but returning the start of the document lets me see what version of similar type document it is.
I can see a few applications for the Find solution though, including returning the enclosing paragraph to determine relevant solutions.

I like your use of strReverse. Not a function I've used, but now I see a practical application. I tend to go with Split as a one line solution

foundfile = Split(foundfile, "\")(UBound(Split(foundfile, "\")))
'or even
foundfilename = Split(Split(foundfile, "\")(UBound(Split(foundfile, "\"))), ".")(0)

I'll go and read the Help file now!
Regards
Malcolm