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

Материал из VB Эксперт
Перейти к: навигация, поиск

Adding an Attachment to a Message

   <source lang="vb">

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

</source>
   
  


Placing a PowerPoint Slide in an Outlook Message

   <source lang="vb">

 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

</source>