Activating a Microsoft Office application

When you use early binding, you must establish a reference to a version-specific object library, using Tools➪References in the VBE.

When you use late binding, setting that reference is not required. Both approaches have pros and cons.

Word Automation

Sub MakeMemos()

'   Creates memos in word using Automation (late binding)

    Dim WordApp As Object

    Dim Data As Range, message As String

    Dim Records As Integer, i As Integer

    Dim Region As String, SalesAmt As String, SalesNum As String

    Dim SaveAsName As String

   

'   Start Word and create an object

    Set WordApp = CreateObject("Word.Application")

   

'   Information from worksheet

    Set Data = Sheets("Sheet1").Range("A1")

    message = Sheets("Sheet1").Range("Message")

   

'   Cycle through all records in Sheet1

    Records = Application.CountA(Sheets("Sheet1").Range("A:A"))

    For i = 1 To Records

'       Update status bar progress message

        Application.StatusBar = "Processing Record " & i

 

'       Assign current data to variables

        Region = Data.Cells(i, 1).Value

        SalesNum = Data.Cells(i, 2).Value

        SalesAmt = Format(Data.Cells(i, 3).Value, "#,000")

 

       

'       Determine the file name

        SaveAsName = ThisWorkbook.Path & "\" & Region & ".docx"

 

'       Send commands to Word

        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 & Region & " Region Manager"

                .TypeParagraph

                .TypeText Text:="From:" & vbTab & _

                   Application.UserName

                .TypeParagraph

                .TypeParagraph

                .TypeText message

                .TypeParagraph

                .TypeText Text:="Units Sold:" & vbTab & SalesNum

                .TypeParagraph

                .TypeText Text:="Amount:" & vbTab & _

                  Format(SalesAmt, "$#,##0")

            End With

                .ActiveDocument.SaveAs FileName:=SaveAsName

        End With

    Next i

'   Kill the object

    WordApp.Quit

    Set WordApp = Nothing

'   Reset status bar

    Application.StatusBar = ""

    MsgBox Records & " memos were created and saved in " & ThisWorkbook.Path

    '   Show the folder

    Shell "explorer.exe " & ThisWorkbook.Path, 1

 

End Sub

Outlook Mail Automation

Sub SendEmail()

  Dim OutlookApp As Object

  Dim MItem As Object

  Dim cell As Range

  Dim Subj As String

  Dim EmailAddr As String

  Dim Recipient As String

  Dim Bonus As String

  Dim Msg As String

 

  'Create Outlook object

  Set OutlookApp = CreateObject("Outlook.Application")

 

  'Loop through the rows

  For Each cell In Columns("B").Cells.SpecialCells(xlCellTypeConstants)

    If cell.Value Like "*@*" Then

      'Get the data

      Subj = "Your Annual Bonus"

      Recipient = cell.Offset(0, -1).Value

      EmailAddr = cell.Value

      Bonus = Format(cell.Offset(0, 1).Value, "$0,000.")

           

     'Compose message

      Msg = "Dear " & Recipient & vbCrLf & vbCrLf 'Carriage return–linefeed combination

      Msg = Msg & "I am pleased to inform you that "

      Msg = Msg & "your annual bonus is "

      Msg = Msg & Bonus & vbCrLf & vbCrLf

      Msg = Msg & "William Rose" & vbCrLf

      Msg = Msg & "President"

   

      'Create Mail Item and send it

      Set MItem = OutlookApp.CreateItem(0)

      With MItem

        .To = EmailAddr

        .Subject = Subj

        .Body = Msg

        .Display

        'NOTE: To actually send the emails, use .Send instead of .Display

      End With

    End If

  Next

End Sub