The following will perform the intended task on doc format files in the selected folder. It also provides the option to cancel the task, and ignores docx files. It also uses ranges instead of the selection object:
Code:
Sub MassFormatFiles()
'
' MassFormatFiles Macro
' Page Setup dialog box. Thus, things like paper size, margins, header and footer locations, and orientation
'
Dim strFilename As String
Dim strPath As String
Dim oDoc As Document
Dim fDialog As FileDialog
Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
With fDialog
.Title = "Select folder and click OK"
.AllowMultiSelect = False
.InitialView = msoFileDialogViewList
If .Show <> -1 Then
MsgBox "Cancelled By User", , _
"List Folder Contents"
Exit Sub
End If
strPath = fDialog.SelectedItems.Item(1)
If Len(strPath) > 3 Then strPath = strPath & Chr(92)
End With
If Left(strPath, 1) = Chr(34) Then
strPath = Mid(strPath, 2, Len(strPath) - 2)
End If
strFilename = Dir$(strPath & "*.doc")
Application.ScreenUpdating = False
While Len(strFilename) <> 0
If Right(LCase(strFilename), 3) = "doc" Then
WordBasic.DisableAutoMacros 1
Set oDoc = Documents.Open(strPath & strFilename)
With oDoc.PageSetup
.LineNumbering.Active = False
.Orientation = wdOrientPortrait
.TopMargin = InchesToPoints(0.5)
.BottomMargin = InchesToPoints(0.5)
.LeftMargin = InchesToPoints(0.5)
.RightMargin = InchesToPoints(0.5)
.Gutter = InchesToPoints(0)
.HeaderDistance = InchesToPoints(0.5)
.FooterDistance = InchesToPoints(0.5)
.PageWidth = InchesToPoints(8.5)
.PageHeight = InchesToPoints(11)
.FirstPageTray = wdPrinterDefaultBin
.OtherPagesTray = wdPrinterDefaultBin
.SectionStart = wdSectionNewPage
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.VerticalAlignment = wdAlignVerticalTop
.SuppressEndnotes = False
.MirrorMargins = False
.TwoPagesOnOne = False
.BookFoldPrinting = False
.BookFoldRevPrinting = False
.BookFoldPrintingSheets = 1
.GutterPos = wdGutterPosLeft
End With
With oDoc.Range
.Font.Name = "Times New Roman"
.Font.Size = 12
With .Paragraphs(1).Range
.Style = ActiveDocument.Styles("Heading 1")
.Font.Name = "Times New Roman"
.Font.Size = 22
.Font.Color = 192
End With
End With
oDoc.Close SaveChanges:=wdSaveChanges
WordBasic.DisableAutoMacros 0
End If
strFilename = Dir$()
Wend
Application.ScreenUpdating = True
lbl_Exit:
Exit Sub
End Sub
Note that this version only addresses the main document body. Other story ranges need to be processed separately, though this was equally true of the original.
It would be better if you created and applied the required styles to the text rather than manual formatting, as this makes it so much simpler to edit next time.
DOC format can store macros. You don't want automacros to run while running the process, so that too has been addressed.
If you want to process sub folders see