Loop Through all documents in a folder

ballpoint · #1 11-05-2017, 07:21 AM

I am trying to run a similar macro to https://www.msofficeforums.com/word-...ocx-files.html (actually, a much simplified version of it), but to no avail.

My idea is to run a macro I have (foot2inline) on a number of files, but I am somehow failing at that.

I have done this:

Code:

Sub UpdateDocuments()
Application.ScreenUpdating = False
Dim strFolder As String, strFile As String, wdDoc As Document
strFolder = GetFolder
If strFolder = "" Then Exit Sub
strFile = Dir(strFolder & "\*.docx", vbNormal)
While strFile <> ""
  Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
  With wdDoc
    Call foot2inline
    .Close SaveChanges:=True
  End With
  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

Word appears to start something, but then everything goes back to a blank sheet. Is there anything obvious I am missing? Thanks!

macropod · #2 11-05-2017, 12:56 PM

Assuming you're running this from Word (what you mean by "everything goes back to a blank sheet" is ambiguous), there is no reason the code stub you'd posted won't work properly. For all we know, though, the problem is with your foot2inline code - which you haven't posted.

PS: I've split this off to a separate thread as, aside from looping through a folder or Word files, the topic seems unrelated to the original one.

ballpoint · #3 11-05-2017, 12:58 PM

You are absolutely correct, sorry for the omission.

Here is the code:

Code:

Sub foot2inline()
Dim oFeets As Footnotes
Dim oFoot As Footnote
Dim oRange As Range
Dim szFootNoteText As String
Dim index As Long

' Grabs the collection of FootNotes
Set oFeets = ActiveDocument.Footnotes

' Iterates through each footnote
For Each oFoot In oFeets
    index = index + 1
    szFootNoteText = oFoot.Range.Text
    
    'Start search from beginning of document
    Set oRange = ActiveDocument.Range
      
    With oRange.Find
        .Text = "^f" ' Looks for all footnotes
        .Forward = True
        .Wrap = wdFindStop
        .Execute
    End With
    
    ' Delete the footnote
    oFoot.Delete
    
    'Insert the footnote text
    oRange.Text = " [Note " & index & ": " & szFootNoteText & "] "

    'CHANGE COLOR HERE. Color code is below.
    'oRange.Font.Color = 6299648

    'Disables undo to save memory on very large documents.
    'ActiveDocument.UndoClear
Next
End Sub

macropod · #4 11-05-2017, 01:26 PM

Try:

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
      Call Foot2Inline(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 Foot2Inline(wdDoc As Document)
Dim i As Long, Rng1 As Range, Rng2 As Range
With wdDoc
  For i = .Footnotes.Count To 1 Step -1
    With .Footnotes(i)
      Set Rng1 = .Reference
      Set Rng2 = .Range
      Rng2.End = Rng2.End - 1
      With Rng1
        .Collapse wdCollapseEnd
        .Font.Reset
        .FormattedText = Rng2.FormattedText
        .InsertBefore "[Note " & i & ": "
        .InsertAfter "]"
        .Font.Color = 6299648
      End With
      .Delete
    End With
  Next
End With
End Sub

Note: The above code preserves formatting in your footnotes (e.g. bold italics, etc.).

ballpoint · #5 11-05-2017, 03:40 PM

Thank you so much for taking the time and producing this stellar code!

Guessed · #6 12-13-2018, 04:27 PM

FWIW, I still think the code should also include docx and docm files. For a minor coding efficiency improvement, I would also change the GetFolder function to add the trailing "" to the returned string. This would remove the need to include it separately 3 times in the calling macro.

Code:

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 & Application.PathSeparator
  Set oFolder = Nothing
End Function

macropod · #7 12-13-2018, 08:20 PM

Quote:

Originally Posted by Guessed

FWIW, I still think the adjusted code should also include docx and docm files as per an earlier suggestion.

Simply searching via:
strFile = Dir(strFolder & "\*.doc", vbNormal)
will return docx & docm files as well as doc files.

Guessed · #8 12-13-2018, 09:28 PM

Sorry Paul, you are correct.

I didn't know that.

shpkmom · #9 08-15-2022, 10:37 AM

Thank you so much for this! I have modified the coding a bit to match a macro I am working on. This macro is to loop through all the documents in a folder, search and replace some text and save and close the document. The problem is that the document will save even if no changes were actually made. The user wants to be able to identify which documents were actually changed. Is there a way to do that?

Guessed · #10 08-15-2022, 04:24 PM

You can test whether Word considers the document had a change made before deciding whether to save.
Try changing this code

Code:

    With wdDoc
      Call Foot2Inline(wdDoc)
      .Close SaveChanges:=True
    End With

To this (untested aircode)

Code:

    With wdDoc
      Call Foot2Inline(wdDoc)
      If .Saved then
         .Close SaveChanges:=False
      Else
         .Close SaveChanges:=True
      End If
    End With

macropod · #11 08-15-2022, 05:24 PM

shpkmom: Kindly don't post the same question in multiple threads. In any event, you've omitted crucial details here as to what is going on in your document (see https://www.msofficeforums.com/word-...h-replace.html).

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
How to open Documents folder directly from CTRL+O of Open folder on QAT	scvjudy	Word	2	08-11-2014 10:58 PM
Content of all documents in folder changes to match one of them	jemmac2525	Word	2	11-11-2013 12:32 AM
Office 2010 Can't Open Or Save Documents in My Documents Folder	trippb	Office	1	07-12-2013 07:29 AM
Documents saved to wrong folder	stevecarr	Word	1	09-22-2011 05:32 AM
Loop through folder of workbooks and copy range to other workbook	Snvlsfoal	Excel Programming	3	07-29-2011 05:55 AM