Sub MakeMemos()
Dim WordApp As Object
Set WordApp = CreateObject("Word.Application")
For i = 1 To 3
Application.StatusBar = "Processing Record " & i
SaveAsName = ThisWorkbook.Path & "\test.doc"
With WordApp
.Documents.Add
With .Selection
.Font.Size = 14
.Font.Bold = True
.ParagraphFormat.Alignment = 1
.TypeText Text:="M E M O R A N D U M"
.TypeParagraph
.TypeParagraph
.Font.Size = 12
.ParagraphFormat.Alignment = 0
.Font.Bold = False
.TypeText Text:="Date:" & vbTab & Format(Date, "mmmm d, yyyy")
.TypeParagraph
.TypeText Text:="To:" & vbTab & " Manager"
.TypeParagraph
.TypeText Text:="From:" & vbTab & _
Application.userName
.TypeParagraph
.TypeParagraph
.TypeText "text"
.TypeParagraph
.TypeParagraph
.TypeText Text:="Units Sold:" & vbTab & "asdf"
.TypeParagraph
.TypeText Text:="Amount:" & vbTab & Format(1000, "$#,##0")
End With
.ActiveDocument.SaveAs FileName:=SaveAsName
.ActiveWindow.Close
End With
Next i
WordApp.Quit
Set WordApp = Nothing
Application.StatusBar = ""
MsgBox " memos were created and saved in " & ThisWorkbook.Path
End Sub