Solved: Sending emails from Access

I'm creating a database for the contact details of the various people involved with our company.

I'm trying to enable people to click on a contact and email that contact at the click of a button. I've set up some VBA to open a New Message in Outlook with the appropriate email address, etc.

However I'm at something of a loss as to what to do if the person using the database doesn't use Outlook. Some people in the office use Outlook express for example. Any ideas? My code is included below.

[vba]
Private Sub cmdEmail_Click()

StartOutLook

End Sub

Public Function StartOutLook()
On Error GoTo Err_Handling
Dim objOutlook As Object
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient

Set objOutlook = CreateObject("Outlook.Application")

Set objOutlookMsg = objOutlook.CreateItem(olMailItem)

With objOutlookMsg

Set objOutlookRecip = .Recipients.Add(tbemail.Value)
objOutlookRecip.Type = olTo

.Subject = "Message from SP Projects"
.Body = "Dear " & cboTitle & " " & tbLastName
.Importance = olImportanceHigh
.Display

End With

Set objOutlook = Nothing
Exit Function

Err_Handling:
MsgBox "Error: " & Err & " " & Error
Exit Function

End Function
[/vba]

Use CDO instead

[vba]
Function sendmail(emailfrom, emailto, emailbcc, emailsubject, emailcorpo)
Dim MiaMail

Set MiaMail = Server.CreateObject("CDO.Message")

MiaMail.From = emailfrom
MiaMail.To = emailto
'MiaMail.Cc = "tom@gogo.com"
MiaMail.BCC = emailbcc
MiaMail.Subject = emailsubject
MiaMail.HTMLBody = emailcorpo
MiaMail.AddAttachment "d:\file.zip"
MiaMail.Fields("urn:schemas:httpmail:importance").Value = 2
MiaMail.Fields.Update()
MiaMail.Send()

Set MiaMail = Nothing
End Function
[/vba]

Edited 8-Jun-07 by geekgirlau. Reason: insert vba tags

Right thanks. How can I set it so that instead of the email just being sent, it opens so that the user can edit it?

Instead, You can provide the required fields on Form Like To,CC,BCC,Subject, Body (for message with text formatting) or HTML Body (for message with HTML Body) and just send an e-mail without any prompts.

Regards,
Upendra

I don't really know anything about CDO, but I couldn't get the one you've just given me to work. Because it wasn't recognising the word Server in this line. Any ideas why?

[vba]
Set MiaMail = Server.CreateObject("CDO.Message")
[/vba]

However, I did get a slightly different one from the internet which I've customised a bit, see below. strEmail is generated by a login screen when the application starts.

[vba]
Private Sub cmdSend_Click()

Dim cdoConfig
Dim msgOne

Set cdoConfig = CreateObject("CDO.Configuration")
With cdoConfig.Fields
.Item(cdoSendUsingMethod) = cdoSendUsingPort
.Item(cdoSMTPServerPort) = 25
.Item(cdoSMTPServer) = "pop.iomartmail.com"
.Item(cdoSendUserName) = strEmail
.Item(cdoSendPassword) = ********
.Update
End With

Set msgOne = CreateObject("CDO.Message")
Set msgOne.Configuration = cdoConfig
msgOne.To = tbTo
msgOne.From = strEmail & "@name.com
msgOne.Subject = tbSubject
msgOne.TextBody = tbBody
msgOne.Send

End Sub
[/vba]
However when I try to run this I get this error:

Run-time error '-2147220973 (80040213)
The transport failed to connect to the server

Any ideas why this is?

Okay I've realised why that particular error was. I've changed

[VBA]
.Item(cdoSMTPServer) = "pop.iomartmail.com"
[/VBA]


to

[VBA]
.Item(cdoSMTPServer) = "smpt.iomartmail.com"
[/VBA]

But now I'm getting this error.

Run-time error '-2147220975 (80040211)
The message could not be sent to the smtp server. The transport error code was 0x80040217. The server response was not available

Any ideas why this is?

actually it's working now! I've changed

[VBA]
.Item(cdoSendUserName) = strEmail
[/VBA]

to

[VBA]
.Item(cdoSendUserName) = strEmail & "@name.com"
[/VBA]

Thanks a lot.