Word macro that adds the file name to the body text of a series of Word documents in a folder

3
votes

I need a Word macro that adds the file name of a document to the first line of that Word document. But not just one document at a time. I would like the Macro to add these file names to a series of Word documents in a particular folder (with each document getting their own file name).

A Macro that adds the file name to document is simple:

Selection.HomeKey Unit:=wdStory
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, _
    Text:= "FILENAME  "
Selection.TypeParagraph

But how can I get it to add file names to an entire series of documents in a folder? I suppose the folder could be named in the Macro. For example: C:\Users\username\Desktop\somefolder\. I also suppose that a Loop could be used to go through the folder until the loop gets to the end of the documents in the folder.

1
vbams-word

1 Answers

0
votes

This should at least get you started. I haven't tested it, but I've written this type of thing a few times before, so the basic idea works. 

Dim filePath As String
Dim thisDoc As Document
Dim wordApp As Word.Application
Set wordApp = New Word.Application

'wordApp.Visible = True ' uncomment if you want to watch things happen

'Get first file that matches
filePath = Dir("C:\Users\username\Desktop\somefolder\*.doc") ' or *.whatever
Do While filePath <> ""
    Set thisDoc = wordApp.Documents.Open(filePath)

    'Add filename at top of document
    Selection.HomeKey Unit:=wdStory
    Selection.InsertAfter filePath
    'Selection.InsertAfter ThisDocument.FullName ' alternative
    'Your way using .Fields.Add is also fine if you want the file name as 
    ' a field instead of 
    ' plain text.

    thisDoc.Close SaveChanges:=True

    'Get next file that matches and start over
    filePath = Dir()
Loop

wordApp.Quit
Set wordApp = Nothing