Having Issues Applying a Macro Across Multiple Files. Changes Just Don't Seem To Save.

Kajex · #1 09-07-2017, 02:07 PM

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

gmayor · #2 09-07-2017, 09:07 PM

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

Kajex · #3 09-08-2017, 06:37 AM

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