Placing a PowerPoint Slide in an Outlook Message : Email Attachment « Outlook « VBA / Excel / Access / Word

1. VBA / Excel / Access / Word
2. Outlook
3. Email Attachment

Placing a PowerPoint Slide in an Outlook Message

 
  Sub Notify_of_New_Presentation()

      Dim myPresentation As Presentation
      Dim strPresentationFilename As String
      Dim strPresentationTitle As String
      Dim strPresentationPresenter As String
      Dim myOutlook As Outlook.Application
      Dim myMessage As Outlook.MailItem
      Const errOutlookNotRunning = 429

      On Error GoTo ErrorHandler

      Set myPresentation = ActivePresentation
      With myPresentation
          strPresentationFilename = .FullName
          strPresentationTitle = _
              .Slides(1).Shapes(1).TextFrame.TextRange.Text
          strPresentationPresenter = _
              .Slides(1).Shapes(2).TextFrame.TextRange.Text
      End With

      Set myOutlook = GetObject(, "Outlook.Application")
      Set myMessage = myOutlook.CreateItem(ItemType:=olMailItem)
      With myMessage
          .To = "your@your.com"
          .CC = "Presentation Archive"
          .Subject = "Presentation for review: " & strPresentationTitle
          .BodyFormat = olFormatHTML
          .Body = "Please review the following presentation:" & _
              vbCr & vbCr & "Title: " & strPresentationTitle & vbCr & _
              "Presenter: " & strPresentationPresenter & vbCr & vbCr & _
              "The presentation is in the file: " & _
              strPresentationFilename
          .Send
      End With

      myOutlook.Quit


      Set myMessage = Nothing
      Set myOutlook = Nothing
      Exit Sub
  ErrorHandler:
      If Err.Number = errOutlookNotRunning Then
          Set myOutlook = CreateObject("Outlook.Application")
          Err.Clear
          Resume Next
      Else
          MsgBox Err.Number & vbCr & Err.Description, vbOKOnly + _
              Critical, "An Error Has Occurred"
    End If
End Sub

 

Related examples in the same category