Email with Outlook from Access

[darklink64]

Hi,

I've recently set up a database, but have not experience of VBA and
need to find a way of solving this problem.

Basically, I would like to make a form with two buttons. On clicking
one button an input box should appear asking for an email address and
then an email should be sent to that address with an attachement. The
other button should send an email to all the addresses in the email
address field in a table.

I've been trying to work with some code I've found on the internet, but
I can't seem to implement it properly.

This is what I've been working with:

http://www.mvps.org/access/modules/mdl0019.htm

'**************** Usage Example Start ****************
Sub TestMAPIEmail()
Dim clMAPI As clsMAPI
Set clMAPI = New clsMAPIEmail
With clMAPI
.MAPILogon
.MAPIAddMessage
.MAPISetMessageBody = "Test Message"
.MAPISetMessageSubject = "Some Test"
.MAPIAddRecipient stPerson:="(e-mail address removed)", _
intAddressType:=1 'To
.MAPIAddRecipient stPerson:="Dev Ashish", _
intAddressType:=2 'cc
.MAPIAddRecipient stPerson:="smtp:[email protected]", _
intAddressType:=3 'bcc

.MAPIAddAttachment "C:\temp\Readme.doc", "Jet Readme"
.MAPIAddAttachment stFile:="C:\config.sys"

.MAPIUpdateMessage
.MAPISendMessage boolSaveCopy:=False
.MAPILogoff
End With
End Sub
'**************** Usage Example End ****************

'**************** Class Start ***********************
'This code was originally written by Dev Ashish
'It is not to be altered or distributed,
'except as part of an application.
'You are free to use it in any application,
'provided the copyright notice is left unchanged.
'
'Code Courtesy of
'Dev Ashish
'
Option Compare Database
Option Explicit

Private mobjSession As MAPI.Session
Private mobjMessage As Message
Private mboolErr As Boolean
Private mstStatus As String
Private mobjNewMessage As Message

Private Const mcERR_DOH = vbObjectError + 10000
Private Const mcERR_DECIMAL = 261144 'low word order +1000

Public Sub MAPIAddMessage()
With mobjSession
Set mobjNewMessage = .Outbox.Messages.Add
End With
End Sub

Public Sub MAPIUpdateMessage()
mobjNewMessage.Update
End Sub

Private Sub Class_Initialize()
mboolErr = False
End Sub

Private Sub Class_Terminate()
On Error Resume Next
Set mobjMessage = Nothing
mobjSession.Logoff
Set mobjSession = Nothing
End Sub

Public Property Let MAPISetMessageBody(stBodyText As String)
If Len(stBodyText) > 0 Then mobjNewMessage.Text = stBodyText
End Property

Public Property Let MAPISetMessageSubject(stSubject As String)
If Len(stSubject) > 0 Then mobjNewMessage.Subject = stSubject
End Property

Public Property Get MAPIIsError() As Boolean
MAPIIsError = mboolErr
End Property

Public Property Get MAPIRecipientCount() As Integer
MAPIRecipientCount = mobjNewMessage.Recipients.Count
End Property

Public Sub MAPIAddAttachment(stFile As String, _
Optional stLabel As Variant)
Dim objAttachment As Attachment
Dim stMsg As String

On Error GoTo Error_MAPIAddAttachment

If mboolErr Then Err.Raise mcERR_DOH
If Len(Dir(stFile)) = 0 Then Err.Raise mcERR_DOH + 10

mstStatus = SysCmd(acSysCmdSetStatus, "Adding Attachments...")

If IsMissing(stLabel) Then stLabel = CStr(stFile)

With mobjNewMessage
.Text = " " & mobjNewMessage.Text
Set objAttachment = .Attachments.Add
With objAttachment
.Position = 0
.Name = stLabel
'no need to link a file me thinks
.Type = CdoFileData
.ReadFromFile stFile
End With
.Update
End With

Exit_MAPIAddAttachment:
Set objAttachment = Nothing
Exit Sub
Error_MAPIAddAttachment:
mboolErr = True
If Err = mcERR_DOH + 10 Then
stMsg = "Couldn't locate the file " & vbCrLf
stMsg = stMsg & "'" & stFile & "'." & vbCrLf
stMsg = stMsg & "Please check the file name and path and try
again."
MsgBox stMsg, vbExclamation + vbOKOnly, "File Not Found"
ElseIf Err <> mcERR_DOH Then
MsgBox "Error " & Err.Number & vbCrLf & Err.Description
End If
Resume Exit_MAPIAddAttachment
End Sub

Public Sub MAPIAddRecipient(stPerson As String, intAddressType As
Integer)
Dim objNewRecipient As Recipient 'local

On Error GoTo Error_MAPIAddRecipient
mstStatus = SysCmd(acSysCmdSetStatus, "Adding Recipients...")

If mboolErr Then Err.Raise mcERR_DOH

'If there's no SMTP present in the stPerson var, then
'we have to use Name, else Address
With mobjNewMessage
If InStr(1, stPerson, "SMTP:") > 0 Then
Set objNewRecipient = .Recipients.Add(Address:=stPerson, _
Type:=intAddressType)
Else
Set objNewRecipient = .Recipients.Add(Name:=stPerson, _
Type:=intAddressType)
End If
objNewRecipient.Resolve
End With

Exit_MAPIAddRecipient:
Set objNewRecipient = Nothing
Exit Sub

Error_MAPIAddRecipient:
mboolErr = True
Resume Exit_MAPIAddRecipient
End Sub

Public Sub MAPISendMessage(Optional boolSaveCopy As Variant, _
Optional boolShowDialog As Variant)

mstStatus = SysCmd(acSysCmdSetStatus, "Sending message...")
If IsMissing(boolSaveCopy) Then
boolSaveCopy = True
End If
If IsMissing(boolShowDialog) Then
boolShowDialog = False
End If

mobjNewMessage.Send savecopy:=boolSaveCopy,
showdialog:=boolShowDialog
End Sub

Public Sub MAPILogon()
On Error GoTo err_sMAPILogon
Const cERROR_USERCANCEL = -2147221229

mstStatus = SysCmd(acSysCmdSetStatus, "Login....")
Set mobjSession = CreateObject("MAPI.Session")
mobjSession.Logon

exit_sMAPILogon:
Exit Sub

err_sMAPILogon:
mboolErr = True
If Err = CdoE_LOGON_FAILED - mcERR_DECIMAL Then
MsgBox "Logon Failed", vbCritical + vbOKOnly, "Error"
ElseIf Err = cERROR_USERCANCEL Then
MsgBox "Aborting since you pressed cancel.", _
vbOKOnly + vbInformation, "Operatoin Cancelled!"
Else
MsgBox "Error number " & Err - mcERR_DECIMAL & " description. "
_
& Error$(Err)
End If
Resume exit_sMAPILogon
End Sub

Public Sub MAPILogoff()
On Error GoTo err_sMAPILogoff
mstStatus = SysCmd(acSysCmdSetStatus, "Logging off...")
mobjSession.Logoff

Set mobjNewMessage = Nothing
Set mobjSession = Nothing
mstStatus = SysCmd(acSysCmdClearStatus)
exit_sMAPILogoff:
Exit Sub

err_sMAPILogoff:
Resume exit_sMAPILogoff
End Sub
'**************** Class End ***********************

I also found some code on the microsoft website that looked promising,
but again, I'm not sure how to exactly implement it and get it to do
what I want. The code on the Microsoft website is here:

http://support.microsoft.com/?kbid=209948

I would be really grateful for any help! Thanks so much!

Ben

 

[Cyberwolf]

Have you tried using the sendobject method? It works quite well for
me. It allows the sending of objects via your default email program.
Go into a new module and hit F1 and search on sendobject. It gives you
all of the particulars.

Cyberwolf