Update fields in all documents in a folder

prhmusic · #1 02-19-2018, 01:12 PM

I'm trying to apply the code in https://www.msofficeforums.com/word-...ts-folder.html but substituting a macro I have called RefreshFields2, but it doesn't seem to be working. What am I missing?

Code:

Sub UpdateDocuments()
'
' updateDocuments Macro
'
'
' Sub UpdateDocuments()
Application.ScreenUpdating = False
Dim strDocNm As String, strFolder As String, strFile As String, wdDoc As Document
strFolder = GetFolder
If strFolder = "" Then Exit Sub
strFile = Dir(strFolder & "\*.doc", vbNormal)
strDocNm = ThisDocument.FullName
While strFile <> ""
  If strFolder & "\" & strFile <> strDocNm Then
    Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
    With wdDoc
      Call refreshFields2
      .Close SaveChanges:=True
    End With
  End If
  strFile = Dir()
Wend
Set wdDoc = Nothing
Application.ScreenUpdating = True
End Sub
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
Sub refreshFields2()
' Macro to update whole document, Fields and TOCs
Dim oStory As Range
Dim oTOC As TableOfContents
Dim oTOF As TableOfFigures
  For Each oStory In ActiveDocument.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 ActiveDocument.TablesOfContents
        oTOC.Update
    Next oTOC
For Each oTOF In ActiveDocument.TablesOfFigures
        oTOF.Update
    Next oTOF
    ActiveDocument.Save
    .Close SaveChanges:=True
End Sub

macropod · #2 02-19-2018, 01:59 PM

It's not clear what you mean by 'not working', but one problem you'll have is that the 'refreshFields2' sub closes the active document, leaving wdDoc in the UpdateDocuments sub undefined.

In any event, you should be able to achieve the same result with:

Code:

Sub UpdateDocuments()
Application.ScreenUpdating = False
Dim strDocNm As String, strFolder As String, strFile As String, wdDoc As Document
strFolder = GetFolder
If strFolder = "" Then Exit Sub
strFile = Dir(strFolder & "\*.doc", vbNormal)
strDocNm = ThisDocument.FullName
While strFile <> ""
  If strFolder & "\" & strFile <> strDocNm Then
    Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
    With wdDoc
      .Fields.Update
      .PrintPreview
      .ClosePrintPreview
      .Close SaveChanges:=True
    End With
  End If
  strFile = Dir()
Wend
Set wdDoc = Nothing
Application.ScreenUpdating = True
End Sub
 
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

Exactly why you'd need to do this on a folder of closed documents is far from clear, however.

prhmusic · #3 02-19-2018, 02:30 PM

Let me set the stage a bit more.

I have a directory "S:\disaster Recovery Planning" which has multiple sub-folders with multiple Word documents in each. For example:
|
S:\disaster Recovery Planning\Standards.docx
S:\disaster Recovery Planning\System1\System1.docx
S:\disaster Recovery Planning\System2\System2.docx
|
Each of these Word documents has a field that is hooked to a heading in the S:\disaster Recovery Planning\Standards.docx file by a bookmark. For example, the bookmark for the "Overview" headings is this:
|
{ INCLUDETEXT "S:\\Disaster Recovery Planning\ \DRMStandards.docx" Overview_01 }
|
In the DRMStandards.docx file, I have this as the "Overview_01" bookmark:
|
{ TITLE \* MERGEFORMAT } - Section 01 - Overview
|
What I want to be able to do is to go to the DRMStandards.docx file and change the text in the Overview_01 bookmark - say I want to make it be the following (as a simple example):
|
{ TITLE \* MERGEFORMAT } - Part 01 - Overview
|
I want to run the macro to go to each document and run the RefreshAllFields code so that I don't have to manually open up S:\disaster Recovery Planning\System1\System1.docx, run the RefreshAllFields macro, close the file, open S:\disaster Recovery Planning\System2\System2.docx, run the RefreshAllFields macro, and so forth.

I set this up, with the bookmarks and fields because I want the flexibility to edit the heading verbiage and be able to update all the Word documents that are set up like this. I need to scale this methodology because eventually, there could be hundreds of Word documents in this folder structure and manually opening each is not going to be an option! <grin>

Thus, that's why I posted my initial reply.

I created a new .DOTM file and created the UpdateDocuments macro as follows:

Code:

Sub UpdateDocuments()
'
' UpdateDocuments Macro
'
Application.ScreenUpdating = False
Dim strDocNm As String, strFolder As String, strFile As String, wdDoc As Document
strFolder = GetFolder
If strFolder = "" Then Exit Sub
strFile = Dir(strFolder & "\*.doc", vbNormal)
strDocNm = ThisDocument.FullName
While strFile <> ""
  If strFolder & "\" & strFile <> strDocNm Then
    Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
    With wdDoc
      .Fields.Update
      .PrintPreview
      .ClosePrintPreview
      .Close SaveChanges:=True
    End With
  End If
  strFile = Dir()
Wend
Set wdDoc = Nothing
Application.ScreenUpdating = True
End Sub
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

When I ran that code, I chose the "S:\Disaster Recovery Planning\AEROSCOUT" folder which has 3 Word documents" with these Modified Dates:
|
File 1 has a modified date = 1/5/2018 10:22 AM
File 2 has a modified date = 1/5/2018 10:25 AM
File 3 has a modified date = 1/5/2018 10:26 AM
|
After I ran the code, I expected the "Date Modified" column to change, but it didn't - I still see
|
File 1 has a modified date = 1/5/2018 10:22 AM
File 2 has a modified date = 1/5/2018 10:25 AM
File 3 has a modified date = 1/5/2018 10:26 AM
|
I'm sorry if I just changed the requirements on you - I didn't mean to in light of seeing your comment on post #15 - https://www.msofficeforums.com/word-...html#post47785 - as I was trying to do this on my own. I didn't post my question until after I had hit a brick wall.

I hope that gives more insight into what I'm trying to do.

macropod · #4 02-19-2018, 02:49 PM

OK, a print preview won't refresh links in headers to other files. In that case, simply revert to your previous code, but delete:

ActiveDocument.Save
.Close SaveChanges:=True

from the 'refreshFields2' macro.

prhmusic · #5 02-19-2018, 03:39 PM

At the risk of being a pain, the Modified Date column values didn't change when I replaced the original code, minus the two lines.

Here's a thought.

I could add code to the RefreshFields2 macro to first find all instances of a word - I'm pretty sure "overview" is in every Word doc in this folder structure - and replace it with the word "overview", save the document, and then second to process the code that actually updates the fields? If I did that, at least I could verify the Word documents were actually being updated...

macropod · #6 02-19-2018, 04:21 PM

Try replacing:
Call refreshFields2
with:
Call RefreshFields(wdDoc)
and replacing your 'refreshFields2' sub with:

Code:

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

prhmusic · #7 02-21-2018, 08:11 AM

Well, I'm closer - thanks for your patience!

Using the code in post #11, I was able to make the macro work! It was so awesome... but only for a single folder, not its sub-folders.

So I tried to use the code from https://www.msofficeforums.com/word-...html#post47785 and have been unsuccessful.

I'm trying to learn through this exercise and noticed a line about "ScreenUpdating" and had a question about it. I saw it is set to "False":

Code:

Application.ScreenUpdating = False

If I changed that line to

Code:

Application.ScreenUpdating = True

would I see the macro doing its magic?

This is the current version of the code & I'm obviously missing something....

Code:

Dim FSO As Object, oFolder As Object, StrFolds As String
Sub Main()
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
End Sub
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
Sub UpdateDocuments(oFolder As String)
'
' updateDocuments Macro
'
'
' Sub UpdateDocuments()
Application.ScreenUpdating = False
Dim strDocNm As String, strFolder As String, strFile As String, wdDoc As Document
strInFolder = oFolder
If strFolder = "" Then Exit Sub
strFile = Dir(strFolder & "\*.docx", vbNormal)
strDocNm = ThisDocument.FullName
While strFile <> ""
  If strFolder & "\" & strFile <> strDocNm Then
    Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
    With wdDoc
      Call RefreshFields(wdDoc)
      .Close SaveChanges:=True
    End With
  End If
  strFile = Dir()
Wend
Set wdDoc = Nothing
Application.ScreenUpdating = True
End Sub
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
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

macropod · #8 02-21-2018, 03:49 PM

Changing the 'ScreenUpdating' line to 'True' only slows down the macro and causes a lot of screen flicker; it doesn't mean you see each change, especially since the code is also written to not show the documents that are being processed (via Visible:=False). Even if you changed that, you'd be unlikely to see much activity, since the code never selects any of the objects being worked on.

As said in the thread you linked to, it would be nice if you said up-front what you want to do. It is only now that you've mentioned sub-folder processing.

Your code should now be:

Code:

Option Explicit
Dim FSO As Object, oFolder As Object, StrFolds As String
 
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
 
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

Sub UpdateDocuments(oFolder As String)
Dim strFolder As String, strFile As String, wdDoc As Document
strFile = Dir(strFolder & "\*.docx", vbNormal)
While strFile <> ""
  Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
  With wdDoc
    Call RefreshFields(wdDoc)
    'Optional - create a PDF of the updated document
    '.SaveAs2 FileName:=Split(.Fullname, ".doc")(0) & ".pdf", FileFormat:=wdFormatPDF, AddToRecentFiles:=False
    .Close SaveChanges:=True
  End With
  strFile = Dir()
Wend
Set wdDoc = Nothing
End Sub

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
 
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

prhmusic · #9 02-23-2018, 05:22 AM

Thank you macropod! I used this code to process 354 Word files spread throughout 193 folders. Works like a charm!

If you ever need a drummer, look me up!

My blog: http://prhmusic.blogspot.com
Me Playing Drums: http://prhmusic.blogspot.com/p/videos-of-me-playing-drums.html
Twitter: @prhmusic

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
how to update calculated fields	sectionbreak	Mail Merge	4	06-04-2014 12:12 AM
Office 2010 Can't Open Or Save Documents in My Documents Folder	trippb	Office	1	07-12-2013 07:29 AM
macro to update fields	PeaceDove	Word	3	01-17-2012 02:45 PM
VBA to update certain (but not all) fields	sparkyrose	Word VBA	0	05-20-2010 12:50 PM
Can no longer update fields!	slindsay	Word	0	09-03-2009 05:10 PM