This is It! This is the ONE!

Received a reply to the thread: http://www.msofficeforums.com/word-vba/38290-update-fields-all-documents-folder.html

---

It should be* strFolder* not *StrInFolder *However it would in any case appear superfluous

Code:

---

Sub UpdateDocuments(strFolder As String) Dim strFile As String, wdDoc As Document
If strFolder = "" Then Exit Sub
Do Until Right(strFolder, 1) = Chr(92)
strFolder = strFolder & Chr(92)
Loop
strFile = Dir(strFolder & "*.docx", vbNormal)
While strFile <> ""
Set wdDoc = Documents.Open(FileName:=strFolder & strFile, AddToRecentFiles:=False, Visible:=False)
With wdDoc
Call RefreshFields(wdDoc)
.Close SaveChanges:=True
End With
strFile = Dir()
Wend
Set wdDoc = Nothing
End Sub

---

Here's the working macro, which includes the code above down below!

---

'Part I
Option Explicit
Dim FSO As Object, oFolder As Object, StrFolds As String
'Part II
Sub Main()
Application.ScreenUpdating = False
Dim TopLevelFolder As String, TheFolders As Variant, aFolder As Variant, i As Long
TopLevelFolder = GetFolder
StrFolds = vbCr & TopLevelFolder
If FSO Is Nothing Then
Set FSO = CreateObject("Scripting.FileSystemObject")
End If
'Get the sub-folder structure
Set TheFolders = FSO.GetFolder(TopLevelFolder).SubFolders
For Each aFolder In TheFolders
RecurseWriteFolderName (aFolder)
Next
'Process the documents in each folder
For i = 1 To UBound(Split(StrFolds, vbCr))
Call UpdateDocuments(CStr(Split(StrFolds, vbCr)(i)))
Next
Application.ScreenUpdating = True
End Sub
'Part III
Sub RecurseWriteFolderName(aFolder)
Dim SubFolders As Variant, SubFolder As Variant
Set SubFolders = FSO.GetFolder(aFolder).SubFolders
StrFolds = StrFolds & vbCr & CStr(aFolder)
On Error Resume Next
For Each SubFolder In SubFolders
RecurseWriteFolderName (SubFolder)
Next
End Sub
'Part IV
Sub UpdateDocuments(strFolder As String) Dim strFile As String, wdDoc As Document
If strFolder = "" Then Exit Sub
Do Until Right(strFolder, 1) = Chr(92)
strFolder = strFolder & Chr(92)
Loop
strFile = Dir(strFolder & "*.docx", vbNormal)
While strFile <> ""
Set wdDoc = Documents.Open(FileName:=strFolder & strFile, AddToRecentFiles:=False, Visible:=False)
With wdDoc
Call RefreshFields(wdDoc)
.Close SaveChanges:=True
End With
strFile = Dir()
Wend
Set wdDoc = Nothing
End Sub

'Part V
Sub RefreshFields(wdDoc As Document)
Dim oStory As Range, oTOC As TableOfContents, oTOF As TableOfFigures
With wdDoc
For Each oStory In .StoryRanges
oStory.Fields.Update
If oStory.StoryType <> wdMainTextStory Then
While Not (oStory.NextStoryRange Is Nothing)
Set oStory = oStory.NextStoryRange
oStory.Fields.Update
Wend
End If
Next oStory
For Each oTOC In .TablesOfContents
oTOC.Update
Next oTOC
For Each oTOF In .TablesOfFigures
oTOF.Update
Next oTOF
End With
End Sub
'Part VI
Function GetFolder() As String
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function

---