Date: 02-16-2022
Return to Index
created by gbSnippets
'Compilable Example: (Jose Includes)
#Compiler PBWin 10
#Compile Exe
#Dim All
%Unicode = 1
#Include "Win32API.inc"
%olMailItem = &H0
%olTo = &H1
%olCC = &H2
%olFormatUnspecified = &H0
%olFormatPlain = &H1
%olFormatHTML = &H2
%olFormatRichText = &H3
Enum Equates Singular
IDC_Button
End Enum
Global hDlg As Dword
Function PBMain() As Long
Dialog New Pixels, 0, "PowerBASIC",300,300,200,200, %WS_OverlappedWindow To hDlg
Control Add Button, hDlg, %IDC_Button,"Push", 50,10,100,20
Dialog Show Modal hDlg Call DlgProc
End Function
CallBack Function DlgProc() As Long
Select Case Cb.Msg
Case %WM_Command
Select Case Cb.Ctl
Case %IDC_Button
SendOutlookMail (_
"[email protected]", _ 'To
"" , _ 'CC
"Test" , _ 'Subject
"Body of message" , _ 'Body
%olFormatPlain , _ 'Body Format %olFormatPlain, %olFormatUnspecified, %olFormatRichText, %olFormatHTML
0 , _ 'Importance ?
"" , _ 'Attachment
%False) '%True-Display Outlook %False-Run Quiet
End Select
End Select
End Function
'=============================================================================
' SendOutlookMail() Function using late-binding and minimal error checking
'=============================================================================
Function SendOutlookMail( 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 _
) Export As Long
Local oOutlook As Dispatch
Local oMessage As Dispatch
Local oRecipient As Dispatch
Local oAttach As Dispatch
Local sName As String
Local i As Long
Local vVar As Variant
Local vTemp As Variant
'===========================
' Create an outlook session
'
oOutlook = NewCom "Outlook.Application"
If IsFalse IsObject(oOutlook) Then
? "Outlook Object Could not be created", %MB_Ok, "Error"
Function = %FALSE
Exit Function
End If
'================================
' Create a Message
'
Let vTemp = %olMailItem
Object Call oOutlook.CreateItem(vTemp) To oMessage
If IsNothing(oMessage) Then ? "oMessage failed. err=" & Str$(Err)
'==================================
' Create Recipient
'
For i = 1 To ParseCount(sEmailTo,";")
sName = Parse$(sEmailTo, ";", i)
Let vTemp = sName
Object Call oMessage.Recipients.Add(vTemp) To oRecipient
Let vTemp = %olTo
Object Let oRecipient.Type = vTemp
Next
' Add a CC if specified
If Len(RTrim$(sEmailCC)) Then
For i = 1 To ParseCount(sEmailCC,";")
sName = Parse$(sEmailCC, ";", i)
Let vTemp = sName
Object Call oMessage.Recipients.Add(vTemp) To oRecipient
Let vTemp = %olCC
Object Let oRecipient.Type = vTemp
Next
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
http://www.garybeene.com/sw/gbsnippets.htm