VBA/Excel/Access/Word/Outlook/Email Attachment

Материал из VB Эксперт
Версия от 12:47, 26 мая 2010; Admin (обсуждение | вклад) (1 версия)
(разн.) ← Предыдущая | Текущая версия (разн.) | Следующая → (разн.)
Перейти к: навигация, поиск

Adding an Attachment to a Message

 
Sub attach()
    Dim myMessage As MailItem
    Set myMessage = Application.CreateItem(ItemType:=olMailItem)
    myMessage.Attachments.Add _
        Source:="C:\g.ppt", _
        Position:=1, DisplayName:="Downsizing Presentation"
End Sub



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.ru"
          .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