|
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
|