Hi. I have the following code in a module which sends email via Outlook.
Option Compare Database
Option Explicit
' Declare module level variables
Dim mOutlookApp As Outlook.Application
Dim mNameSpace As Outlook.NameSpace
Dim mFolder As mapiFolder
Dim mItem As MailItem
Dim fSuccess As Boolean
' Module contains only 2 methods:
' 1) GetOutlook()
' 2) SendMessage()
'
Public Function GetOutlook() As Boolean
' The GetOutlook() function sets the Outlook Application
' and Namespase objects and opens MS Outlook
On Error Resume Next
' Assume success
fSuccess = True
Set mOutlookApp = GetObject("", "Outlook.application")
' If Outlook is NOT Open, then there will be an error.
' Attempt to open Outlook
If Err.Number > 0 Then
Err.Clear
Set mOutlookApp = CreateObject("Outlook.application")
If Err.Number > 0 Then
MsgBox "Could not create Outlook object", vbCritical
fSuccess = False
Exit Function
End If
End If
' If we've made it this far, we have an Outlook App Object
' Now, set the NameSpace object to MAPI Namespace
Set mNameSpace = mOutlookApp.GetNamespace("MAPI")
If Err.Number > 0 Then
MsgBox "Could not create NameSpace object", vbCritical
fSuccess = False
Exit Function
End If
' Return the Success Flag as the value of GetOutlook()
GetOutlook = fSuccess
End Function
Public Function SendMessage() As Boolean
' The SendMessage() function reads user entered values and
' actually sends the message.
On Error Resume Next
Dim strRecip As String
Dim strSubject As String
Dim strMsg As String
Dim strAttachment As String
Dim StrBody As String
Dim dlgopenfile As FileDialog
strSubject = Forms!frmsendmail!TxtSubject
strRecip = Forms!frmsendmail!TxtRecipient
StrBody = Forms!frmsendmail!TxtBody
strAttachment = dlgopenfile.SelectedItems(0)
strAttachment = Forms!frmsendmail!TxtAttachment
' Any amount of validation could be done at this point, but
' at a minimum, you need to verify that the user supplied an
' Email address for a recipient.
If Len(strRecip) = 0 Then
strMsg = "You must designate a recipient."
FormattedMsgBox strMsg, vbExclamation, "Error"
Exit Function
ElseIf Len(strSubject) = 0 Then
strMsg = "Your message must have a subject."
FormattedMsgBox strMsg, vbExclamation, "Error"
Forms!frmsendmail!TxtSubject.SetFocus
Exit Function
ElseIf Len(StrBody) = 0 Then
strMsg = "Your message must have some text in the body."
FormattedMsgBox strMsg, vbExclamation, "Error"
Forms!frmsendmail!TxtBody.SetFocus
Exit Function
End If
' Assume success
fSuccess = True
' Here's where the real Outlook Automation takes place
If GetOutlook = True Then
Set mItem = mOutlookApp.CreateItem(olMailItem)
mItem.Recipients.Add strRecip
mItem.Subject = strSubject
mItem.Body = StrBody
mItem.Attachments = strAttachment
' This code allows for 1 attachment, but with slight
' modification, you could provide for multiple files.
If Len(strAttachment) > 0 Then
mItem.Attachments.Add strAttachment
End If
mItem.Send
End If
' Release resources
Set mOutlookApp = Nothing
Set mNameSpace = Nothing
If Err.Number > 0 Then fSuccess = False
SendMessage = fSuccess
End Function
' -- End Code Here -->
This is the way I call the Modules from a command button:
If GetOutlook = False Then
MsgBox "Outlook is closed", vbOKOnly
Call GetOutlook
MsgBox "Outlook is open", vbOKOnly
End If
Call SendMessage
If SendMessage = True Then
FormattedMsgBox "The Message was sent successfully."
End If
DoCmd.Close
End Sub
Everything works with the exception of three problems:
1.) When I click the Send Mail Button on the form, the code sends TWO
identical emails to the address specified.
2.) I cannot figure out how to add attachments that I choose from the
openfile dialog. I can choose files but I do not see them listed in the
txtattachments dialog and they do not get sent with the email.
3.) Iam using Office System Outlook and I get annoying security warnings
when I send the E-Mails. Is there a way to suppress the warnings?
Thank you for your assistance
Colin
P.S.
If you recognize this code, could you please tell me who wrote it so
that I can credit them properly?
*** Sent via Developersdex
http://www.developersdex.com ***
Don't just participate in USENET...get rewarded for it!
