Getting the sender's e-mail

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

I know there is no way to get the email address of the sender in the
Application_ItemSend method.

I want to automatically bcc a copy of every email sent from Outlook to some
email address. I have the codes for that from
http://www.outlookcode.com/d/code/autobcc.htm. My issue now is that for each
individual email account I have on the PC, I want them to bcc their outgoing
email to different email address. Is there anyway to do that?
 
Am Sun, 27 Aug 2006 17:48:02 -0700 schrieb wrytat:

With CDO 1.21 or Redemption (www.dimastr.com) you can read the field 0x8581,
which contains info about the sending account. Before that field is
available you must save the e-mail.
 
I've installed both CDO and Redemption. Then I tried using the
R_GetSenderAddress(Item) and GetFromAddress(Item) methods as illustrated in
the article, at the Application_ItemSend event. For the
R_GetSenderAddress(Item) method, it returns nothing (null). And for the
GetFromAddress(Item) method it couldn't continue because there's a bug. Why?
 
This is how my code looks like (I removed the BCC part),

Function R_GetSenderAddress(objMsg)
Dim strType
Dim objSenderAE ' Redemption.AddressEntry
Dim objSMail ' Redemption.SafeMailItem
Const PR_SENDER_ADDRTYPE = &HC1E001E
Const PR_EMAIL = &H39FE001E

Set objSMail = CreateObject("Redemption.SafeMailItem")
objSMail.Item = objMsg
strType = objSMail.Fields(PR_SENDER_ADDRTYPE)
Set objSenderAE = objSMail.Sender
If Not objSenderAE Is Nothing Then
If strType = "SMTP" Then
R_GetSenderAddress = objSenderAE.Address
res = MsgBox(objSenderAE.Address, vbInformation, "Sender")
ElseIf strType = "EX" Then
R_GetSenderAddress = objSenderAE.Fields(PR_EMAIL)
res = MsgBox(objSenderAE.Fields(PR_EMAIL), vbInformation, "Sender")
End If
End If

Set objSenderAE = Nothing
Set objSMail = Nothing

End Function

Function GetFromAddress(objMsg)
' start CDO session
Set objSession = CreateObject("MAPI.Session")
objSession.Logon "", "", False, False

' pass message to CDO
strEntryID = objMsg.EntryID
strStoreID = objMsg.Parent.StoreID
Set objCDOMsg = objSession.GetMessage(strEntryID, strStoreID)

' get sender address
On Error Resume Next
strAddress = objCDOMsg.Sender.Address
If Err = &H80070005 Then
'handle possible security patch error
MsgBox "The Outlook E-mail and CDO Security Patches are " & _
"apparently installed on this machine. " & _
"You must response Yes to the prompt about " & _
"accessing e-mail addresses if you want to " & _
"get the From address.", vbExclamation, _
"GetFromAddress"
End If

GetFromAddress = strAddress

Set objCDOMsg = Nothing
objSession.Logoff
Set objSession = Nothing
End Function

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)

res = MsgBox(R_GetSenderAddress(Item), vbInformation, "Sender")
res = MsgBox(GetFromAddress(Item), vbInformation, "Sender")

End Sub

When I tried sending an email, this is the error message I received,
Run-time error '-2147221241 (80040107)':

[Collaboration Data Objects -
[MAPI_E_INVALID_ENTRYID(80040107)]]

[Continue(disabled)] [End] [Debug] [Help]

And this is the line that fails,
Set objCDOMsg = objSession.GetMessage(strEntryID, strStoreID)

And R_GetSenderAddress(Item) returns nothing.
 
Am Tue, 29 Aug 2006 18:38:01 -0700 schrieb wrytat:

You need to call Item.Save before it gets an EntryID. Without that
objSession.GetMessage fails.

--
Viele Gruesse / Best regards
Michael Bauer - MVP Outlook
-- www.VBOffice.net --

This is how my code looks like (I removed the BCC part),

Function R_GetSenderAddress(objMsg)
Dim strType
Dim objSenderAE ' Redemption.AddressEntry
Dim objSMail ' Redemption.SafeMailItem
Const PR_SENDER_ADDRTYPE = &HC1E001E
Const PR_EMAIL = &H39FE001E

Set objSMail = CreateObject("Redemption.SafeMailItem")
objSMail.Item = objMsg
strType = objSMail.Fields(PR_SENDER_ADDRTYPE)
Set objSenderAE = objSMail.Sender
If Not objSenderAE Is Nothing Then
If strType = "SMTP" Then
R_GetSenderAddress = objSenderAE.Address
res = MsgBox(objSenderAE.Address, vbInformation, "Sender")
ElseIf strType = "EX" Then
R_GetSenderAddress = objSenderAE.Fields(PR_EMAIL)
res = MsgBox(objSenderAE.Fields(PR_EMAIL), vbInformation, "Sender")
End If
End If

Set objSenderAE = Nothing
Set objSMail = Nothing

End Function

Function GetFromAddress(objMsg)
' start CDO session
Set objSession = CreateObject("MAPI.Session")
objSession.Logon "", "", False, False

' pass message to CDO
strEntryID = objMsg.EntryID
strStoreID = objMsg.Parent.StoreID
Set objCDOMsg = objSession.GetMessage(strEntryID, strStoreID)

' get sender address
On Error Resume Next
strAddress = objCDOMsg.Sender.Address
If Err = &H80070005 Then
'handle possible security patch error
MsgBox "The Outlook E-mail and CDO Security Patches are " & _
"apparently installed on this machine. " & _
"You must response Yes to the prompt about " & _
"accessing e-mail addresses if you want to " & _
"get the From address.", vbExclamation, _
"GetFromAddress"
End If

GetFromAddress = strAddress

Set objCDOMsg = Nothing
objSession.Logoff
Set objSession = Nothing
End Function

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)

res = MsgBox(R_GetSenderAddress(Item), vbInformation, "Sender")
res = MsgBox(GetFromAddress(Item), vbInformation, "Sender")

End Sub

When I tried sending an email, this is the error message I received,
Run-time error '-2147221241 (80040107)':

[Collaboration Data Objects -
[MAPI_E_INVALID_ENTRYID(80040107)]]

[Continue(disabled)] [End] [Debug] [Help]

And this is the line that fails,
Set objCDOMsg = objSession.GetMessage(strEntryID, strStoreID)

And R_GetSenderAddress(Item) returns nothing.



Dmitry Streblechenko said:
Please show your code. Indicate which line of code fails.

Dmitry Streblechenko (MVP)
http://www.dimastr.com/
OutlookSpy - Outlook, CDO
and MAPI Developer Tool
Click to expand...
Click to expand...
 
Back
Top