VBA Express : Word - Add extract of files in a folder with hyperlink to same

Word

Add extract of files in a folder with hyperlink to same

Ease of Use

Easy

Version tested with

2000,2003

Submitted by:

mdmackillop

Description:

The code will create an index of files in a folder, using the file name as a hyperlink header followed by a selected number of the first few paragraphs

Discussion:

A set of published documents may not be easily identifiable from the file name alone. This code creates a usable index based on the first few paragraphs of each document. The source folder can be hard coded or accessed by browser as shown in the example.

Code:

instructions for use

			Option Explicit 
 
Sub GetList() 
    Dim MyDoc As Document 
    Dim Source As Document 
    Dim MyFile As String 
    Dim Location As String 
    Dim Extract As String 
    Dim txt As String 
    Dim txtBlock As Range 
    Dim x As Long 
     
     'Set number of paragraphs to be returned.
    Const ListParas = 5 
     
    Set MyDoc = ActiveDocument 
     'Clear previous data
    MyDoc.Range.Delete 
     
     'Browse for or set location
     'Location = BrowseForFolder & "\"
    Location = "C:\Source\Minor\" 
     
     'Set tabs etc. for imported data
    With Selection.ParagraphFormat 
        .LeftIndent = CentimetersToPoints(2#) 
        .FirstLineIndent = CentimetersToPoints(-2#) 
        .TabStops.Add Position:=CentimetersToPoints(1#), _ 
        Alignment:=wdAlignTabLeft 
        .TabStops.Add Position:=CentimetersToPoints(2#), _ 
        Alignment:=wdAlignTabLeft 
    End With 
     
     'Set location
    ChangeFileOpenDirectory Location 
    MyFile = Dir(Location & "*.DOC") 
    If MyFile = "" Then Exit Sub 
     
    With MyDoc 
         'Insert path as header
        .Range.InsertAfter Location & vbCr & vbCr 
        .Paragraphs(1).Range.Bold = True 
        Do 
            If MyFile <> MyDoc.Name Then 
                 'Open file and get text from selected number of paragraphs
                Set Source = Documents.Open(FileName:=MyFile, Visible:=False) 
                Extract = Source.Range(Source.Paragraphs(1).Range.Start, _ 
                Source.Paragraphs(ListParas).Range.End).Text 
                Source.Close 
                 'Add filename as hyperlink at end of document
                MyDoc.Hyperlinks.Add Anchor:=MyDoc.Bookmarks("\EndOfDoc").Range, _ 
                Address:=Location & MyFile, TextToDisplay:=CStr(MyFile) 
                 'Add Extract with breaks at end of document
                txt = vbCr & Extract & vbCr 
                .Range.InsertAfter txt 
                 'Format block to keep together
                x = .Paragraphs.Count 
                Set txtBlock = .Range(.Paragraphs(x - (ListParas + 2)).Range.Start, _ 
                .Paragraphs(x - 2).Range.End) 
                txtBlock.ParagraphFormat.KeepWithNext = True 
            End If 
             'Get next file
            MyFile = Dir 
        Loop Until MyFile = "" 
    End With 
End Sub

How to use:

Copy and paste the code into a standard module of a new document.
Change Location to the Browse option or set your own location
Set ListParas to the number of paragraphs you wish to copy.
Save your changes
Close the Visual Basic Editor and run the code

Test the code:

Copy the attached sample to the C drive
Open GetList.doc.
Press Alt + F8 and run GetList macro

Sample File:

Source.zip 74.25KB

Approved by mdmackillop

This entry has been viewed 185 times.