Sub BatchPageSizer()
  Dim sPath As String, aSect As Section, aDoc As Document, iCounter As Integer
  Dim oFSO As Object, oFolder As Object, oFile As Object
  
  sPath = SelectFolder("Select folder for page sizing")
  Set oFSO = CreateObject("Scripting.FileSystemObject")
  Set oFolder = oFSO.GetFolder(sPath)
  
  For Each oFile In oFolder.files
    If Left(oFile.Type, 14) = "Microsoft Word" And Left(oFile.Name, 1) <> "~" Then
      Set aDoc = Documents.Open(FileName:=oFile.Path, Visible:=True, AddToRecentFiles:=False)
      iCounter = iCounter + 1
      For Each aSect In aDoc.Sections
        aSect.PageSetup.PageWidth = InchesToPoints(15)
        aSect.PageSetup.PageHeight = InchesToPoints(8.5)
      Next aSect
      aDoc.Close SaveChanges:=True
    End If
  Next
  MsgBox "Docs processed: " & iCounter, vbOKOnly, "Macro Finished"
End Sub

'===========================================================
Function SelectFolder(Optional sTitle As String = "Select a Folder") As String
  Dim diaFolder As FileDialog
  ' Open the file dialog
  Set diaFolder = Application.FileDialog(msoFileDialogFolderPicker)
  With diaFolder
    .AllowMultiSelect = False
    .Title = sTitle
    .Show
    SelectFolder = .SelectedItems(1)
  End With
  Set diaFolder = Nothing
End Function