I have to write a program that tracks production stats for dozens of employees. Each week the supervisor will need to send to each employee a copy of their weekly stats using Microsoft Outlook (version 2010 in this case). I want my program to be able to automate the sending of that email with one press of a button.
Here is the code that I have put together based on a sample of late binding of Outlook that I found by Jim Dunn. Hopefully someone here may find it useful as well. I assume I can also use direct interface calls but I haven't tried that yet.
(uses PB10 and Jose's includes, of course)
' Send an Email through Outlook using late-binding
' Tested using Outlook 2010
#Compile Exe
#Dim All
#Include "windows.inc"
'====================================================
' Declare Constants
'
' Itemtype
%olMailItem = 0
' MailRecipientType
%olOriginator = 0
%olTo = 1
%olCC = 2
%olBCC = 3
' AttachmentType
%olByValue = 1
%olByReference = 4 ' This value is no longer supported since Microsoft Outlook 2007
%olEmbeddedItem = 5
%olOLE = 6
' Importance
%olImportanceLow = 0
%olImportanceNormal = 1
%olImportanceHigh = 2
' BodyFormat
%olFormatUnspecified = 0
%olFormatPlain = 1
%olFormatHTML = 2
%olFormatRichText = 3
'=============================================================================
' SendOutlookMessage() Function using late-binding and minimal error checking
'=============================================================================
Function SendOutlookMessage( ByVal sEmailTo As String, _
ByVal sEmailCC As String, _
ByVal sSubject As String, _
ByVal sBodyText As String, _
ByVal lBodyFormat As Long, _
ByVal lImportance As Long, _
ByVal sAttachment As String, _
ByVal lDisplayOnly As Long _
) As Long
Local oOutlook As Dispatch
Local oMessage As Dispatch
Local oRecipient As Dispatch
Local oAttach As Dispatch
Local vVar As Variant
Local vTemp As Variant
'===========================
' Create an outlook session
'
Try
oOutlook = NEWCOM "Outlook.Application"
If IsFalse IsObject(oOutlook) Then Error 5
Catch
oOutlook = NEWCOM "Outlook.Application"
If IsFalse IsObject(oOutlook) Then
? "Outlook Object Could not be created", %MB_OK, "Error"
Function = %FALSE
Exit Function
End If
End Try
'================================
' Create a Message
'
Let vTemp = %olMailItem
Object Call oOutlook.CreateItem(vTemp) To vVar
Set oMessage = vVar
'==================================
' Create Recipient
'
Let vTemp = sEmailTo
Object Call oMessage.Recipients.Add(vTemp) To vVar
Set oRecipient = vVar
Let vTemp = %olTo
Object Let oRecipient.Type = vTemp
' Add a CC if specified
If Len(RTrim$(sEmailCC)) Then
Let vTemp = sEmailCC
Object Call oMessage.Recipients.Add(vTemp) To vVar
Set oRecipient = vVar
Let vTemp = %olCC
Object Let oRecipient.Type = vTemp
End If
' Add the email Subject
Let vTemp = sSubject
Object Let oMessage.Subject = vTemp
' Add the email body based on the format
Let vTemp = sBodyText
Select Case lBodyFormat
Case %olFormatUnspecified, %olFormatPlain
Object Let oMessage.Body = vTemp
Case %olFormatHTML
Object Let oMessage.HTMLBody = vTemp
Case %olFormatRichText
Object Let oMessage.RTFBody = vTemp
End Select
' Set the email importance
Let vTemp = lImportance
Object Let oMessage.Importance = vTemp
'======================================================================
' Create and Add Attachment if present
'
If Len(Trim$(sAttachment)) <> 0 Then
If Len(Trim$(Dir$(sAttachment))) <> 0 Then
Let vTemp = sAttachment
Object Call oMessage.Attachments.Add(vTemp) To vVar
Set oAttach = vVar
End If
End If
'=======================================================================
' Display Message Before Sending
'
If IsTrue(lDisplayOnly) Then
Object Call oMessage.Display
Else
Object Call oMessage.Save
Object Call oMessage.Send
? "Outlook Email has been sent.", %MB_OK, "Success"
End If
Set oOutlook = Nothing
Function = %TRUE
End Function
Function PBMain()
Local lret As Long
Local sEmailTo As String
Local sEmailCC As String ' optional
Local sSubject As String
Local sBodyText As String
Local lBodyFormat As Long ' plain, html, rtf
Local lImportance As Long ' low, normal, high
Local sAttachment As String ' must use the full system path
Local lDisplayOnly As Long ' display the email before sending it
sEmailTo = "blah@something.com"
sEmailCC = ""
sSubject = "This is a test subject"
sBodyText = "Email body text" & $CrLf & "Last line"
lBodyFormat = %olFormatPlain
lImportance = %olImportanceNormal
sAttachment = CurDir$ & "\attachmentfile.txt"
lDisplayOnly = %FALSE '%TRUE
lret = SendOutlookMessage( sEmailTo, _
sEmailCC, _
sSubject, _
sBodyText, _
lBodyFormat, _
lImportance, _
sAttachment, _
lDisplayOnly)
End Function