#16
|
|||
|
|||
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. |
#17
|
|||
|
|||
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? |
#18
|
||||
|
||||
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] |
#19
|
|||
|
|||
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 |
#20
|
||||
|
||||
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] |
#21
|
|||
|
|||
Oooh I see what I have to change to make your code work!
Many many thanks for reading my post Macropod :-) |
#22
|
|||
|
|||
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 |
#23
|
||||
|
||||
See the link to the installation & usage instructions in post #2.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#24
|
|||
|
|||
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 |
#25
|
||||
|
||||
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] |
#26
|
|||
|
|||
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 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 |
#27
|
|||
|
|||
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 |
#28
|
||||
|
||||
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] |
Tags |
multiple files |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
How to open Docx files? | mond_bees | Word | 12 | 08-29-2012 03:32 AM |
convert multiple csv files to multiple excel files | mit | Excel | 1 | 06-14-2011 10:15 AM |
looking for macro for multiple files | bolk | Word | 3 | 05-03-2011 05:46 AM |
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 |