Sub OpenDocuments()
Set xl = CreateObject("Excel.Application")
Set fs = Application.FileSearch
With fs
FileName = xl.GetOpenFilename("Word Files (*.doc), *.doc")
For i = Len(FileName) To 1 Step -1
If Mid(FileName, i, 1) = "\" Then
Exit For
End If
Next
.LookIn = Left(FileName, i - 1)
.FileName = "*.doc"
If .Execute(SortBy:=msoSortByFileName, _
SortOrder:=msoSortOrderAscending) > 0 Then
MsgBox "There were " & .FoundFiles.Count & _
" file(s) found."
i = 1
For i = 1 To .FoundFiles.Count
Documents.Open FileName:=.FoundFiles(i)
ChangeMargins
ActiveDocument.Save
ActiveDocument.Close
Next i
Else
MsgBox "There were no files found."
End If
End With
End Sub
Sub ChangeMargins()
With ActiveDocument.PageSetup
.TopMargin = InchesToPoints(1)
.BottomMargin = InchesToPoints(1)
.LeftMargin = InchesToPoints(1)
.RightMargin = InchesToPoints(1)
.Gutter = InchesToPoints(0)
.HeaderDistance = InchesToPoints(0.5)
.FooterDistance = InchesToPoints(0.5)
End With
End Sub