Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #16  
Old 07-06-2016, 04:47 AM
cor cor is offline Run a macro on multiple docx. files Windows 8 Run a macro on multiple docx. files Office 2013
Novice
 
Join Date: Jul 2016
Posts: 2
cor is on a distinguished road
Default macro for multiply files (containing linked files)


This code sounds like something very useful for my needs. But I have docx files that have links to xlxs files and when opened there is a popup window asking whether I want to update yes or no. How will this macro handle that and/or can something be added to the macro to always answer YES to such question.
Reply With Quote
  #17  
Old 07-07-2016, 03:22 AM
cor cor is offline Run a macro on multiple docx. files Windows 8 Run a macro on multiple docx. files Office 2013
Novice
 
Join Date: Jul 2016
Posts: 2
cor is on a distinguished road
Default Call word files with an excel macro

I'm trying to get this UpdateDocuments to run from within excel, but it crashes at
Dim wdDoc as Document
with a "compile error: User-defined type not defined".
I want to use some data in the excel file to update my word documents with.
Any thoughts on how to do this?
Reply With Quote
  #18  
Old 07-07-2016, 12:11 PM
macropod's Avatar
macropod macropod is offline Run a macro on multiple docx. files Windows 7 64bit Run a macro on multiple docx. files Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,956
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

The macro is a Word macro, not coded for running from Excel. To do that with the code in post #18, you'd need to set a reference to the Word object library (via Tools|References in the VBE), change:
Dim strFolder As String, strFile As String, wdDoc As Document, i As Long
to:
Dim strFolder As String, strFile As String, wdApp As New Word.Application, wdDoc As Word.Document, i As Long
change:
Set wdDoc = Documents.Open
to:
Set wdDoc = wdApp.Documents.Open
and change:
Set wdDoc = Nothing
to:
Set wdApp = Nothing: Set wdDoc = Nothing

To suppress link alerts, you might try inserting:
wdApp.DisplayAlerts = wdAlertsNone
before:
While strFile <> ""
and inserting:
wdApp.DisplayAlerts = wdAlertsAll
before:
Set wdApp = Nothing: Set wdDoc = Nothing

That said, it's not at all clear why you'd want to do this from Excel.
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #19  
Old 07-21-2017, 01:45 AM
AHKpie AHKpie is offline Run a macro on multiple docx. files Windows 7 64bit Run a macro on multiple docx. files Office 2010 64bit
Novice
 
Join Date: Jun 2017
Posts: 7
AHKpie is on a distinguished road
Default change macro?

Dear Macropod and others, I have been inspired by Macropod's wonderfull script.
My macro2 will work in a 1 single folder. What do I have to change so it will also work for subfolders too? (By the way, macro2 extracts only the index of a document and saves that away.)

Code:
Sub OneFolderbatch()
Application.ScreenUpdating = False
Dim strFolder As String, strFile As String, wdDoc As Document
strFolder = GetFolder
If strFolder = "" Then Exit Sub
strFile = Dir(strFolder & "\*.doc", vbNormal)
While strFile <> ""
 Documents.Open FileName:=strFolder & "\" & strFile
  'Next line you can adapt the Macro to be executed for every document in a single folder
  Call Macro2

  ActiveDocument.Save
  ActiveDocument.Close
  
  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 Macro2()
    With ActiveDocument
        'insert the TOC
        .TablesOfContents.Add _
                Range:=Selection.Range, _
                RightAlignPageNumbers:=True, _
                UseHeadingStyles:=True, _
                UpperHeadingLevel:=1, _
                LowerHeadingLevel:=5, _
                IncludePageNumbers:=True, _
                AddedStyles:="", _
                UseHyperlinks:=True, _
                HidePageNumbersInWeb:=True, _
                UseOutlineLevels:=True
        'select the TOC
        .TablesOfContents.Item(1).Range.Select
        ''Unlink the TOC field
        'Selection.Fields.Unlink
        'Copy the unlinked TOC
        Selection.copy
        'Undo the unlinking to restore the TOC field
        ActiveDocument.Undo 1
        'Next line is optional
        '.TablesOfContents.Item(1).Range.Delete
        Selection.WholeStory
        Selection.Delete Unit:=wdCharacter, Count:=1
        Selection.PasteAndFormat (wdFormatOriginalFormatting)
    End With
    
End Sub
Reply With Quote
  #20  
Old 07-23-2017, 02:57 PM
macropod's Avatar
macropod macropod is offline Run a macro on multiple docx. files Windows 7 64bit Run a macro on multiple docx. files Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,956
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

For adaptations to the code to process both a folder and its sub-folders, see post #15 in this thread: https://www.msofficeforums.com/word-...html#post47785
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #21  
Old 07-23-2017, 11:42 PM
AHKpie AHKpie is offline Run a macro on multiple docx. files Windows 7 64bit Run a macro on multiple docx. files Office 2010 64bit
Novice
 
Join Date: Jun 2017
Posts: 7
AHKpie is on a distinguished road
Default

Oooh I see what I have to change to make your code work!
Many many thanks for reading my post Macropod :-)
Reply With Quote
  #22  
Old 10-19-2019, 11:19 PM
Mohan01 Mohan01 is offline Run a macro on multiple docx. files Windows 10 Run a macro on multiple docx. files Office 2013
Novice
 
Join Date: Oct 2019
Posts: 1
Mohan01 is on a distinguished road
Exclamation need basi assistance to run this code

Hi macropod
I was also searching for similar solution to run a macro( which calls several macro) on multiple .doc stored in a folder
I am unable to know:
1. How exactly to create a macro with your code and then how to run it ?
2. I did normal procedure to create macro with sub name ( UpdateDocuments) . but it did not do any thing though I called another macro in this . can you add any code where it will ask for the folder to search for .doc files and run macro on it
Thanks!!




-Mohan
Reply With Quote
  #23  
Old 10-23-2019, 10:04 PM
macropod's Avatar
macropod macropod is offline Run a macro on multiple docx. files Windows 7 64bit Run a macro on multiple docx. files Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,956
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

See the link to the installation & usage instructions in post #2.
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #24  
Old 05-07-2021, 12:27 PM
Lozfitz Lozfitz is offline Run a macro on multiple docx. files Windows 10 Run a macro on multiple docx. files Office 2013
Novice
 
Join Date: May 2021
Posts: 1
Lozfitz is on a distinguished road
Default

This page has been incredibly helpful this week, but i've got stuck trying to update this code to only update headers.footers.
I have other code that can update headers.footers, but when I to combine yours and mine together something falls over, and i've worn myself out trying to find the issue.
Please can you give me some any advice?

FYI - I am at this point, as I need to update a footer on 700 documents, but the code previously whilst did the job it also incorrectly added a carriage return at the end. So now i'm trying to use the same code but now 2 carriage return are in the footer so the footer is no longer visable.


My combined code

Code:
Sub UpdateDocuments()
Application.ScreenUpdating = False
Dim strInFolder As String, strOutFold As String, strFile As String, wdDoc As Document, oRng As Word.Range, hf As Word.HeaderFooter
strInFolder = GetFolder
If strInFolder = "" Then Exit Sub
strFile = Dir(strInFolder & "\*.doc", vbNormal)
'Check for documents in the folder - exit if none found
If strFile <> "" Then strOutFold = strInFolder & "\Output"
'Test for an existing outpfolder & create one if it doesn't already exist
If Dir(strOutFold, vbDirectory) = "" Then MkDir strOutFold
strFile = Dir(strInFolder & "\*.doc", vbNormal)
While strFile <> ""
  Set wdDoc = Documents.Open(FileName:=strInFolder & "" & strFile, AddToRecentFiles:=False, ReadOnly:=True, Visible:=False)
  Set oRng = hf.Range
    With wdDoc
          With oRng.Find
            .ClearFormatting
            .Replacement.ClearFormatting
            .Forward = True
            .Wrap = wdFindContinue
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchWildcards = False
            .MatchSoundsLike = False
            .MatchAllWordForms = False
            .Text = "^p^p"
            .Replacement.Text = ""
            .Execute Replace:=wdReplaceAll

        End With
    'Save and close the document
    .SaveAs FileName:=strOutFold & .Name, AddToRecentFiles:=False
    .Close
  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
Reply With Quote
  #25  
Old 05-07-2021, 02:29 PM
macropod's Avatar
macropod macropod is offline Run a macro on multiple docx. files Windows 10 Run a macro on multiple docx. files Office 2016
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,956
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

For example:
Code:
Sub UpdateDocuments()
Application.ScreenUpdating = False
Dim strInFolder As String, strOutFold As String, strFile As String
Dim wdDoc As Document, Sctn As Section, HdFt As HeaderFooter
strInFolder = GetFolder: If strInFolder = "" Then Exit Sub
strFile = Dir(strInFolder & "\*.doc", vbNormal)
'Check for documents in the folder - exit if none found
If strFile <> "" Then strOutFold = strInFolder & "\Output"
'Test for an existing outpfolder & create one if it doesn't already exist
If Dir(strOutFold, vbDirectory) = "" Then MkDir strOutFold
strFile = Dir(strInFolder & "\*.doc", vbNormal)
While strFile <> ""
  Set wdDoc = Documents.Open(FileName:=strInFolder & "" & strFile, _
    AddToRecentFiles:=False, ReadOnly:=True, Visible:=False)
  With wdDoc
    'Process the body
    Call Update(.Range)
    For Each Sctn In .Sections
      'Process Headers
      For Each HdFt In Sctn.Headers
        With HdFt
          If Sctn.Index = 1 Then
            Call Update(.Range)
          ElseIf .LinkToPrevious = False Then
            Call Update(.Range)
          End If
        End With
      Next
      'Process Footers
      For Each HdFt In Sctn.Footers
        With HdFt
          If Sctn.Index = 1 Then
            Call Update(.Range)
          ElseIf .LinkToPrevious = False Then
            Call Update(.Range)
          End If
        End With
      Next
    Next
    'Save and close the document
    .SaveAs FileName:=strOutFold & .Name, AddToRecentFiles:=False
    .Close False
  End With
  strFile = Dir()
Wend
Set wdDoc = Nothing
Application.ScreenUpdating = True
End Sub

Sub Update(Rng As Range)
With Rng.Find
  .ClearFormatting
  .Replacement.ClearFormatting
  .Text = "^p^p"
  .Replacement.Text = ""
  .Format = False
  .Forward = True
  .Wrap = wdFindStop
  .Execute Replace:=wdReplaceAll
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
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
  #26  
Old 01-17-2022, 02:46 PM
Venteux Venteux is offline Run a macro on multiple docx. files Windows 10 Run a macro on multiple docx. files Office 2019
Novice
 
Join Date: May 2021
Posts: 22
Venteux is on a distinguished road
Default

I have used this macro multiple times for different things and it's been great! However, I have two macros that I wanted to use it with, and I can't figure out why they're not working. When I run the macro on it's own for an active/open document, it works. But when I insert the code into this UpdateDocuments(), it doesn't work. The macro runs and I don't get any error messages, but when I open the individual files, nothing has been done to them. Am I doing something wrong?

I wanted to mark all documents in a specified folder as spelling and grammar checked already, and I wanted to accept all changes and stop tracking changes. This is the code I used:

Code:
Sub GrammarAndSpelling_Folder()

' GrammarAndSpelling_Folder macro that marks all of the documents in a specified folder as spelling and grammar checked already

Application.ScreenUpdating = False
Dim strFolder As String, strFile As String, strDocNm As String, wdDoc As Document
strDocNm = ActiveDocument.FullName: strFolder = GetFolder
If strFolder = "" Then Exit Sub
strFile = Dir(strFolder & "\*.docx", vbNormal)
While strFile <> ""
  If strFolder & "\" & strFile <> strDocNm Then
    Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
    With wdDoc
      'Call your other macro or insert its code here
	ActiveDocument.SpellingChecked = True
	ActiveDocument.GrammarChecked = True
      .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
The second one was:
Code:
Sub TrackChanges_Folder()

' TrackChanges_Folder macro that accepts all changes and stop tracking

Application.ScreenUpdating = False
Dim strFolder As String, strFile As String, strDocNm As String, wdDoc As Document
strDocNm = ActiveDocument.FullName: strFolder = GetFolder
If strFolder = "" Then Exit Sub
strFile = Dir(strFolder & "\*.docx", vbNormal)
While strFile <> ""
  If strFolder & "\" & strFile <> strDocNm Then
    Set wdDoc = Documents.Open(FileName:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
    With wdDoc
      'Call your other macro or insert its code here
    ActiveDocument.AcceptAllRevisions
    ActiveDocument.TrackRevisions = False
      .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
Reply With Quote
  #27  
Old 12-14-2022, 05:18 PM
learning2automate1 learning2automate1 is offline Run a macro on multiple docx. files Windows 10 Run a macro on multiple docx. files Office 2021
Novice
 
Join Date: Dec 2022
Posts: 1
learning2automate1 is on a distinguished road
Question Batch update Find and Replace in Header and Footers on multiple Word files

Hi, I've been searching for the past few months on how to automate some of my mudane tasks at work. We typically update headers and footers or headers/footers separately to change dates or issuance names. I was able to find a macro to batch update headers which was awesome. My next task is to be able to find and replace a few words in the header and footer in multiple doc and docx files. I've tried the code mentioned however nothing happens and I believe it's because find/replace is not searching header/footer. I have another macro that works when i run it by itself however when adding it to the marco above I'm getting errors. Can you please tell me what's wrong with the macro and or how I can simplify it?



Code:
Application.ScreenUpdating = False
Dim strInFolder As String, strOutFold As String, strFile As String, wdDoc As Document
strInFolder = GetFolder
If strInFolder = "" Then Exit Sub
strFile = Dir(strInFolder & "\*.doc", vbNormal)
'Check for documents in the folder - exit if none found
If strFile <> "" Then strOutFold = strInFolder & "\Output"
'Test for an existing outpfolder & create one if it doesn't already exist
If Dir(strOutFold, vbDirectory) = "" Then MkDir strOutFold
strFile = Dir(strInFolder & "\*.doc", vbNormal)
While strFile <> ""
  Set wdDoc = Documents.Open(FileName:=strInFolder & "" & strFile, AddToRecentFiles:=False, ReadOnly:=True, Visible:=False)
  With wdDoc
Dim rngStory As Range

  For Each rngStory In ActiveDocument.StoryRanges

    With rngStory.Find

      .Text = "ICU Pavilion"

      .Replacement.Text = "ICU Pavilion Increment 5"

      .Wrap = wdFindContinue

      .Execute Replace:=wdReplaceAll
    With rngStory.Find
    
      .Text = "DR 26"

      .Replacement.Text = "DR 44"

      .Wrap = wdFindContinue

      .Execute Replace:=wdReplaceAll
   With rngStory.Find

      .Text = "10/03/2022"

      .Replacement.Text = "01/10/2023"

      .Wrap = wdFindContinue

      .Execute Replace:=wdReplaceAll
 End With
    'Save and close the document
    .SaveAs FileName:=strOutFold & .Name, AddToRecentFiles:=False
    .Close
  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



I'm receiving "compile error: function call on left hand side of assignment must return variant object" this on GetFolder
Reply With Quote
  #28  
Old 12-15-2022, 04:10 PM
macropod's Avatar
macropod macropod is offline Run a macro on multiple docx. files Windows 10 Run a macro on multiple docx. files Office 2016
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,956
macropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond reputemacropod has a reputation beyond repute
Default

The code in post #25 already executes a Find/Replace, including in headers & footers, in all documents in a folder. All you need do is modify the Update(Rng As Range) sub, thus:
Code:
Sub Update(Rng As Range)
With Rng.Find
  .ClearFormatting
  .Replacement.ClearFormatting
  .Format = False
  .Forward = True
  .Wrap = wdFindContinue
  .Text = "ICU Pavilion"
  .Replacement.Text = "ICU Pavilion Increment 5"
  .Execute Replace:=wdReplaceAll
  .Text = "DR 26"
  .Replacement.Text = "DR 44"
  .Execute Replace:=wdReplaceAll
  .Text = "10/03/2022"
  .Replacement.Text = "01/10/2023"
  .Execute Replace:=wdReplaceAll
End With
End Sub
__________________
Cheers,
Paul Edstein
[Fmr MS MVP - Word]
Reply With Quote
Reply

Tags
multiple files

Thread Tools
Display Modes


Similar Threads
Thread Thread Starter Forum Replies Last Post
How to open Docx files? mond_bees Word 12 08-29-2012 03:32 AM
Run a macro on multiple docx. files convert multiple csv files to multiple excel files mit Excel 1 06-14-2011 10:15 AM
Run a macro on multiple docx. files looking for macro for multiple files bolk Word 3 05-03-2011 05:46 AM
Run a macro on multiple docx. files macro to pull data from multiple files psrs0810 Excel 2 10-25-2010 01:49 PM
Icon for docx files Jazz43 Word 2 10-20-2009 08:34 PM

Other Forums: Access Forums

All times are GMT -7. The time now is 05:10 AM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2024, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2024 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft