Sending Outlook email from Access

  • Thread starter Thread starter Mike Whitaker
  • Start date Start date
M

Mike Whitaker

I'm trying to send an email from Access through Outlook (both XP).

The issue is that I'm getting two blank emails brought to the screen, one
addressed correctly (from the code), and the other one blank. Needless to
say, I only want the correct one.

Any thoughts would be appreciated.

Cheers,

Mike

The code is;

Public Function MakeEmail(StrAddress as string, strSubject as string)

Dim O as Outlook.Application
Dim E as Outlook.MailItem

Set O=new Outlook.Application
Set E=O.CreateItem(olMailItem)

E.To=strAddresss
E.Subject=strSubject

E.Display

set E=Nothing
Set O=Nothing

End Function
 
I have just tested your code in the Access/Outlook 2003 environment with no
issues (except you've used a strAddresss variable with three "s"'s instead of
two as per your arrgument).

I only receive one email.

Where are you calling this code from? Maybe you are calling it twice?

Have you tried from the immediate window? (e.g.
?makeEmail("(e-mail address removed)","TEST")
 
Thanks for that.

I'm begining to think that it must be something else, as other code examples
seem to be very similar to mine.

It is a client's database that I've inherited, so there could be other
factors at play.

Cheers,

Mike
 
Try using cdosys.dll

You have to reference cdosys.dll before running this code.
It is accessing Exchange, but I believe it will work locally as well.

Public Function fnSendEmail(ByVal strTo As String, ByVal strFname As String,
ByVal strLname As String)
Dim strName As String
Dim objMsg As New CDO.Message
Dim objConfig As New CDO.Configuration
Dim objFields As Object

On Error GoTo ErrHandler

Set objConfig = New CDO.Configuration
Set objFields = objConfig.Fields

With objFields
.Item(cdoSendUsingMethod) = cdoSendUsingPort
.Item(cdoSMTPServer) = "192.168.1.1" 'Insert your IP Address Here
.Item(cdoSMTPServerPort) = 25
.Item(cdoSMTPConnectionTimeout) = 10
.Item(cdoSMTPAuthenticate) = cdoAnonymous
.Item(cdoSendUserName) = ""
.Item(cdoSendPassword) = ""
.Update
End With

Set objMsg = New CDO.Message

With objMsg

.Configuration = objConfig

.To = strTo

.From = "(e-mail address removed)"

.Subject = "Subject"

strName = strFname & " " & strLname

.TextBody = "The sales commission report for " & strName & " is attached."

.AddAttachment "D:\Milestone\CommissionsReport.rtf"

'I allways use the next lines to get disposition info

.Fields("urn:schemas:mailheader:disposition-notification-to") =
"(e-mail address removed)"
.DSNOptions = cdoDSNSuccessFailOrDelay
.DSNOptions = 14
.Fields.Update

.Send

End With

ExitThisFunction:

Set objMsg = Nothing
Exit Function

ErrHandler:

MsgBox "Error: " & Err.Number & vbNewLine & _
"Descr: " & Err.Description, vbOKOnly, "Error"

Err.Clear
GoTo ExitThisFunction

End Function

=====================================================
 
Back
Top