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