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