Resize Paper for Multiple Files

Guessed · #1 08-20-2019, 03:25 PM

Your screenshot shows you didn't follow the instructions. You had problems with the function so to eliminate that I said the line should be
sPath = "C:\My Files"

you made it
sPath = SelectFolder("C:\Users\ceike\OneDrive\Desktop\New folder\Needs_Resized")

Based on that path, I would have expected you to make it
sPath = "C:\Users\ceike\OneDrive\Desktop\New folder\Needs_Resized"

Despite that error, it appears the macro runs to completion and fails to find any files that meet the requirements. I am not sure how OneDrive works so it could be that there aren't any Word documents in that folder or perhaps OneDrive changes them in some way.

Try this modification with the Immediate Window showing so you can trace why the code is not finding any Word documents in the supplied folder

Code:

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 = "C:\Users\ceike\OneDrive\Desktop\New folder\Needs_Resized"
  Set oFSO = CreateObject("Scripting.FileSystemObject")
  Set oFolder = oFSO.GetFolder(sPath)
  Debug.Print "Files in Folder: " & oFolder.files.count
  
  For Each oFile In oFolder.files
    Debug.Print oFile.Name, oFile.Type
    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

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
can't draw a line in table that is continuing on multiple paper sheets	katka	Word Tables	1	01-24-2015 12:09 AM
Resize multiple PowerPoint objects in a table at the same time	Duradel	Word Tables	3	11-16-2014 04:01 PM
Resize multiple pictures in a Word 2010 table	JBA479	Word VBA	1	01-24-2014 08:51 PM
convert multiple csv files to multiple excel files	mit	Excel	1	06-14-2011 10:15 AM
Resize video across multiple slides	joelas	PowerPoint	3	09-28-2010 07:59 PM