Outlook email routine - "From" field

[Box666]

At work (using Access 2003 and Outlook 2003) we have the ability to
send an email from within an access program. It will come up prefilled
in using information from the Access database. when it is received, the
recipient will see that it is from which every member of the team
originated it.
There is a function in Outlook (and perhaps I should be posting this
item on their group) where by you can have "From" appear on your
message before sending it. This is what we want to happen from within
access as we wish to set the "From" field to our Team mailbox.
We use the following code to originate the Outlook email :-


Option Compare Database
Option Explicit

Sub sbSendMessage(Optional AttachmentPath)
Dim objOutlook As Outlook.Application
Dim objOutlookMsg As Outlook.MailItem
Dim objOutlookRecip As Outlook.Recipient
Dim objOutlookAttach As Outlook.Attachment

On Error GoTo ErrorMsgs

' 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. Substitute your names
here
' your names here.
Set objOutlookRecip = .Recipients.Add([Forms]![BAU
Reports]![subreports]![Recipiant])
objOutlookRecip.Type = olTo
' Add the CC recipient(s) to the message.
Set objOutlookRecip = .Recipients.Add([Forms]![BAU
Reports]![subreports]![Copy reply to])
' [Forms]![BAU Reports]![subreports]![Copy reply to] & "", "",
Forms![BAU Reports]![subreports]![Report name], Forms![BAU Reports]![em
header] & vbCrLf & vbCrLf & Forms![BAU Reports]![subreports]![Report
Main body] & vbCrLf & Forms![BAU Reports]![subreports]![Report body 2]
& vbCrLf & Forms![BAU Reports]![em footer] & vbCrLf & vbCrLf & vbCrLf &
Forms![BAU Reports]![signature], True, ""

objOutlookRecip.Type = olCC
' Set the Subject, Body, and Importance of the message.
.Subject = Forms![BAU Reports]![subreports]![Report name]
.HTMLBody = ([Forms]![BAU Reports]![em header] & vbCrLf & vbCrLf
& Forms![BAU Reports]![subreports]![Report Main body] & vbCrLf &
Forms![BAU Reports]![subreports]![Hlink] & vbCrLf & vbCrLf & Forms![BAU
Reports]![subreports]![Report body 2] & Forms![BAU Reports]![em footer]
& vbCrLf & vbCrLf & vbCrLf & vbCrLf & vbCrLf & Forms![BAU
Reports]![subreports]![Sig] & vbCrLf & vbCrLf)
.Importance = olImportanceHigh 'High importance

' Add attachments to the message.
If Not IsMissing(AttachmentPath) Then
Set objOutlookAttach = .Attachments.Add(AttachmentPath)
End If
' Resolve each Recipient's name.
For Each objOutlookRecip In .Recipients
If Not objOutlookRecip.Resolve Then
objOutlookMsg.Display
End If
Next
.Display
'.Send
End With
Set objOutlookMsg = Nothing
Set objOutlook = Nothing
Set objOutlookRecip = Nothing
Set objOutlookAttach = Nothing

Exit Sub

ErrorMsgs:
If Err.Number = "287" Then
MsgBox "You clicked No to the Outlook security warning. " & _
"Rerun the procedure and click Yes to access e-mail " & _
"addresses to send your message. For more information, " & _
"see the document at http://www.microsoft.com/office" & _
"/previous/outlook/downloads/security.asp. "
Else
MsgBox Err.Number & " " & Err.Description
End If
End Sub

 

[pietlinden]

one option is to use CDOSys per this article:
http://support.microsoft.com/default.aspx?scid=kb;en-us;810702

Then you can specify the sender to any mailbox you want.

set m = CreateObject("CDO.Message")
m.From = "User1 <[email protected]>"
m.To = "Joe € <[email protected]>"
m.Subject = "Unicode content"
set b = m.bodypart
b.charset = "unicode-1-1-utf-7"
m.textbody = "That will be €5, please."
m.send