Freek's Blog

create form
Add button
Make a reference to microsoft scripting runtime

a

Public Function outlookMail(ByVal emailOntvanger As String, ByVal subject As String, ByVal body As String, ByVal bijlage As String) As Boolean

' extra:
' microsoft scripting runtime
' click yes (free software)

On Error GoTo errMsg

 Dim ToAddress
 Dim MessageSubject
 Dim MessageBody
 Dim MessageAttachment
 
 Dim ol, ns, newMail
 
 ToAddress = emailOntvanger
 MessageSubject = subject
 MessageBody = body
 
 
 Set ol = CreateObject("Outlook.Application")
 Set ns = ol.getNamespace("MAPI")
 ns.logon "", "", True, False
 Set newMail = ol.CreateItem(olMailItem)
 newMail.subject = MessageSubject
 newMail.body = MessageBody & vbCrLf

 newMail.Attachments.Add (bijlage)
 
 
 
 ' validate the recipient, just in case...
 Set myRecipient = ns.CreateRecipient(ToAddress)
 myRecipient.Resolve
 If Not myRecipient.Resolved Then
 MsgBox "unknown recipient"
 Else
    newMail.Recipients.Add (myRecipient)
    newMail.Send
 End If
 
 
 Set ol = Nothing

outlookMail = True

Exit Function
errMsg:

outlookMail = False

End Function

'menu: project -> components
'add microsoft MAPI control

'add to the form
'1. MAPISession1
'2. MAPIMessages1
'3. command1 = button

Call outlookExpressMail("f.zomer@xxx.com", "Onderwerp", "body text", "")

End Sub

Dim s1 As String
Dim b1 As Boolean
Dim filename As String
filename = attach                               ' filename path

b1 = False
MAPISession1.SignOn
MAPISession1.DownLoadMail = False
If filename <> "" Then
b1 = True
End If
With MAPIMessages1
            .SessionID = MAPISession1.SessionID
            .Compose
            .RecipAddress = RecipAddress        ' email address
            .AddressResolveUI = True
            .ResolveName
            .MsgSubject = subject               ' subject
             If b1 = True Then
            .AttachmentPathName = filename
             End If
         
            .MsgNoteText = emailBody            ' email body text
            .Send False
End With
MAPISession1.SignOff
'MAPISession1 = Nothing
'MAPIMessages1 = Nothing
End Sub