louiserome
Registered User.
- Local time
- Today, 02:00
- Joined
- May 22, 2001
- Messages
- 14
I'm using the following code to send multiple reports from Access 2000. The problem I have is that I want to use Outlook Express instead of Outlook. Outlook Express is my default e-mail and works ok when your using SendObject. But for this code it's opening Outlook. How do I declare Outlook Express instead of Outlook?
Sub EMail(MsgNumber As Integer)
On Error GoTo EMail_Err
Dim db As Database
Dim rsMySet As Recordset
Dim a As Integer
Dim b
Dim c As Integer
Dim d
Dim e As Integer
Dim f
Dim g As Integer
Dim h
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment
' Set up the recordset from the table
Set db = CurrentDb()
Set rsMySet = db.OpenRecordset("SELECT tblEMail.* FROM tblEMail WHERE (((tblEMail.ID)=" & MsgNumber & "));", dbOpenSnapshot)
' Create the Outlook session.
Set objOutlook = CreateObject("Outlook.Application")
' Create the message.
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
With objOutlookMsg
' Add the To recipient(s) to the message.
For a = 1 To 10
b = rsMySet("C" & a)
If IsNull(b) Then
Else:
Set objOutlookRecip = .Recipients.ADD(b)
objOutlookRecip.Type = olTo
End If
Next a
' Add the CC recipient(s) to the message.
For c = 1 To 10
d = rsMySet("cc" & c)
If IsNull(d) Then
Else:
Set objOutlookRecip = .Recipients.ADD(d)
objOutlookRecip.Type = olCC
End If
Next c
' Add the BCC recipient(s) to the message.
For e = 1 To 10
f = rsMySet("bcc" & e)
If IsNull(f) Then
Else:
Set objOutlookRecip = .Recipients.ADD(f)
objOutlookRecip.Type = olBCC
End If
Next e
' Set the Subject, Body, and Importance of the message.
.Subject = rsMySet("Subject")
.Body = rsMySet("Body") & vbCrLf & vbCrLf
Select Case rsMySet("Importance")
Case "low"
.Importance = olImportanceLow
Case "Normal"
.Importance = olImportanceNormal
Case "High"
.Importance = olImportanceHigh
Case Else
End Select
' Add attachment(s) to the message.
For g = 1 To 5
h = rsMySet("Attachment" & g)
If IsNull(h) Then
Else:
.Attachments.ADD (h)
End If
Next g
' Resolve each Recipient's name.
For Each objOutlookRecip In .Recipients
objOutlookRecip.Resolve
Next
' Should we display the message before sending?
If rsMySet("message") = True Then
.Display
Else
.Save
.Send
End If
End With
rsMySet.Close
EMail_Exit:
Set objOutlook = Nothing
Set rsMySet = Nothing
Set db = Nothing
Exit Sub
EMail_Err:
Select Case Err
Case Else
MsgBox "Unexpected Error# " & Err & " - " & Error$(Err), vbCritical, "Alan - EMail routine"
Resume EMail_Exit
End Select
End Sub
Sub EMail(MsgNumber As Integer)
On Error GoTo EMail_Err
Dim db As Database
Dim rsMySet As Recordset
Dim a As Integer
Dim b
Dim c As Integer
Dim d
Dim e As Integer
Dim f
Dim g As Integer
Dim h
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment
' Set up the recordset from the table
Set db = CurrentDb()
Set rsMySet = db.OpenRecordset("SELECT tblEMail.* FROM tblEMail WHERE (((tblEMail.ID)=" & MsgNumber & "));", dbOpenSnapshot)
' Create the Outlook session.
Set objOutlook = CreateObject("Outlook.Application")
' Create the message.
Set objOutlookMsg = objOutlook.CreateItem(olMailItem)
With objOutlookMsg
' Add the To recipient(s) to the message.
For a = 1 To 10
b = rsMySet("C" & a)
If IsNull(b) Then
Else:
Set objOutlookRecip = .Recipients.ADD(b)
objOutlookRecip.Type = olTo
End If
Next a
' Add the CC recipient(s) to the message.
For c = 1 To 10
d = rsMySet("cc" & c)
If IsNull(d) Then
Else:
Set objOutlookRecip = .Recipients.ADD(d)
objOutlookRecip.Type = olCC
End If
Next c
' Add the BCC recipient(s) to the message.
For e = 1 To 10
f = rsMySet("bcc" & e)
If IsNull(f) Then
Else:
Set objOutlookRecip = .Recipients.ADD(f)
objOutlookRecip.Type = olBCC
End If
Next e
' Set the Subject, Body, and Importance of the message.
.Subject = rsMySet("Subject")
.Body = rsMySet("Body") & vbCrLf & vbCrLf
Select Case rsMySet("Importance")
Case "low"
.Importance = olImportanceLow
Case "Normal"
.Importance = olImportanceNormal
Case "High"
.Importance = olImportanceHigh
Case Else
End Select
' Add attachment(s) to the message.
For g = 1 To 5
h = rsMySet("Attachment" & g)
If IsNull(h) Then
Else:
.Attachments.ADD (h)
End If
Next g
' Resolve each Recipient's name.
For Each objOutlookRecip In .Recipients
objOutlookRecip.Resolve
Next
' Should we display the message before sending?
If rsMySet("message") = True Then
.Display
Else
.Save
.Send
End If
End With
rsMySet.Close
EMail_Exit:
Set objOutlook = Nothing
Set rsMySet = Nothing
Set db = Nothing
Exit Sub
EMail_Err:
Select Case Err
Case Else
MsgBox "Unexpected Error# " & Err & " - " & Error$(Err), vbCritical, "Alan - EMail routine"
Resume EMail_Exit
End Select
End Sub