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