|
|
Thread Tools | Display Modes |
#1
|
|||
|
|||
Having Issues Applying a Macro Across Multiple Files. Changes Just Don't Seem To Save.
As the title states, I'm attempting a (fairly difficult to me) macro that reads goes through a folder of Word files, determines if each file ends on an odd page. If that is the case, it adds a document from a location on my desktop. (This portion works on an individual document, when the code is run on its own). The macro then should save over the original file, and move onto the next. My issue lies in that once the command has finished, including updated save timestamps on my files, no change seems to have taken place. Without a distinct error flag being thrown, I'm pretty much at the end of my wits. Thanks in advance for any insight.
Current code is as follows: Code:
Public Sub PageAdd() Dim FirstLoop As Boolean Dim myFile As String Dim PathToUse As String Dim myDoc As Document Dim Response As Long Dim rngStory As Word.Range PathToUse = InputBox("Enter path to the documents:", _ "PageAdd", _ "C:\Temp") If PathToUse = "" Then Exit Sub If Right(PathToUse, 1) <> "\" Then PathToUse = PathToUse & "\" On Error Resume Next 'Close all open documents before beginning Documents.Close SaveChanges:=wdPromptToSaveChanges 'Boolean expression to test whether first loop 'This is used so that the FindReplace dialog will 'only be displayed for the first document FirstLoop = True 'Set the directory and type of file to batch process myFile = Dir$(PathToUse & "*.doc") While myFile <> "" 'Open document Set myDoc = Documents.Open(PathToUse & myFile) For Each rngStory In ActiveDocument.StoryRanges Do rngStory.Select If ActiveDocument.BuiltInDocumentProperties("number of pages") Mod 2 <> 0 Then Selection.EndKey Unit:=wdStory Selection.InsertBreak Type:=wdSectionBreakNextPage Selection.Collapse Direction:=wdCollapseEnd Selection.InsertFile FileName:="C:\desktop\NOTUSED.DOCX", Link:=True Selection.Sections(1).Headers(wdHeaderFooterPrimary).LinkToPrevious = False Selection.Sections(1).Headers(wdHeaderFooterPrimary).Range.Delete Selection.Sections(1).Footers(wdHeaderFooterPrimary).LinkToPrevious = False Selection.Sections(1).Footers(wdHeaderFooterPrimary).Range.Delete If ActiveWindow.View.SplitSpecial <> wdPaneNone Then ActiveWindow.Panes(2).Close End If If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _ ActivePane.View.Type = wdOutlineView Then ActiveWindow.ActivePane.View.Type = wdPrintView End If ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageHeader ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument End If ActiveDocument.Save Set rngStory = rngStory.NextStoryRange Loop Until rngStory Is Nothing Next 'Close the modified document after saving changes myDoc.Close SaveChanges:=wdSaveChanges 'Next file in folder myFile = Dir$() Wend End Sub Last edited by macropod; 09-07-2017 at 02:52 PM. Reason: Added code tags |
#2
|
||||
|
||||
Your macro doesn't do what you indicate it is supposed to do. Try the following, which does.
Note that C:\Desktop is not the usual location for the Windows desktop That would be Environ("USERPROFILE") & "\Desktop\" Code:
Option Explicit Public Sub PageAdd() Dim myFile As String Dim PathToUse As String Dim myDoc As Document Dim rngStory As Word.Range PathToUse = InputBox("Enter path to the documents:", _ "PageAdd", _ "C:\Temp") If PathToUse = "" Then Exit Sub If Right(PathToUse, 1) <> "\" Then PathToUse = PathToUse & "\" 'On Error Resume Next myFile = Dir$(PathToUse & "*.doc*") While myFile <> "" 'Open document Set myDoc = Documents.Open(PathToUse & myFile) Set rngStory = myDoc.Range If myDoc.BuiltInDocumentProperties("number of pages") Mod 2 <> 0 Then With rngStory .Collapse wdCollapseEnd .InsertBreak wdSectionBreakNextPage .End = myDoc.Range.End .Collapse wdCollapseEnd .InsertFile FileName:="C:\Desktop\NOTUSED.DOCX", link:=True With .Sections(1).Headers(wdHeaderFooterPrimary) .LinkToPrevious = False .Range.Text = "" End With End With myDoc.Close SaveChanges:=wdSaveChanges Else myDoc.Close SaveChanges:=wdDoNotSaveChanges End If 'Next file in folder myFile = Dir$() Wend End Sub
__________________
Graham Mayor - MS MVP (Word) (2002-2019) Visit my web site for more programming tips and ready made processes www.gmayor.com |
#3
|
|||
|
|||
Hey thanks for the quick reply ! I unfortunately don't have too much time to dedicate to this today, but upon trying your code as is (the C:\Desktop was just a placeholder so I remembered where my path was without jumbling my post with a long path), it seems to only affect the document that is active when I run it. The others are opened, and then left unsaved, even if they meet the criteria for modification. I'll get around to toying around later on, this stuff brings me back to troubleshooting my arduino builds in college. Thanks again for the help !
|
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Run a macro on multiple docx. files | Peter Carter | Word VBA | 27 | 12-15-2022 04:10 PM |
Macro for multiple RTF files | papapaleo | Word VBA | 1 | 07-28-2017 04:56 AM |
Macro to Pull Data From Multiple Files | Jess709 | Excel Programming | 30 | 05-20-2015 05:26 PM |
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 |