Outlook Banter

Outlook Banter (http://www.outlookbanter.com/)
-   Outlook and VBA (http://www.outlookbanter.com/outlook-vba/)
-   -   Get smtp address on send (http://www.outlookbanter.com/outlook-vba/65996-get-smtp-address-send.html)

dkgb January 29th 08 09:47 AM

Get smtp address on send
 
Hello,

I would like to save a copy of an email when it is sent if I can find the
SMTP address in a jet database. I have been successful (with the help of
this community) in getting the SMTP address of incoming messages using
Redemption and now I would like to get the addresses of outgoing messages.
However, in the code below, the email address is empty. Can anyone advise?

Private Sub Application_ItemSend(ByVal item As Object, Cancel As Boolean)
Dim retval
retval = FileSendingEmail(item)
End Sub

Function FileSendingEmail(MyMail As Object)
'------Dimension variables----------------
Dim ws As Workspace
Dim db As Database
Dim rst As Recordset
Dim rstlog As Recordset
Dim strID As String
Dim olNS As Outlook.NameSpace
Dim olMail As Outlook.MailItem
Dim utils, PR_SMTP_ADDRESS, SenderEMail
Dim SafeMail
Dim ID As Long
Dim StrPath As String

'-----Open databases-----------------------
DBEngine.SystemDB = "z:\secured.mdw"
Set ws = DBEngine.CreateWorkspace("New", "xxx", "xxx")
Set db = ws.OpenDatabase("Z:\data.mdb")
Set rst = db.OpenRecordset("Suppliers", dbOpenDynaset)
Set rstlog = db.OpenRecordset("Supplierlog", dbOpenDynaset)
'-------------------------------------------------

StrPath = "J:\Documents\"

strID = MyMail.EntryID
Set olNS = Application.GetNamespace("MAPI")
Set olMail = MyMail
'On Error GoTo 0
Set SafeMail = CreateObject("Redemption.SafemailItem")
SafeMail.item = olMail

Set utils = CreateObject("Redemption.MAPIUtils")
PR_SMTP_ADDRESS = &H39FE001E
SenderEMail = utils.HrGetOneProp(olMail.MAPIOBJECT, PR_SMTP_ADDRESS)

rst.FindFirst "Email = '" & SenderEMail & "'"

If Not rst.NoMatch Then
'do stuff
End if
end function

Any ideas?

dkgb January 29th 08 02:33 PM

Get smtp address on send
 
I forgot to mention that I am using Outlook 2002 SP3.

Thanks!

"dkgb" wrote:

Hello,

I would like to save a copy of an email when it is sent if I can find the
SMTP address in a jet database. I have been successful (with the help of
this community) in getting the SMTP address of incoming messages using
Redemption and now I would like to get the addresses of outgoing messages.
However, in the code below, the email address is empty. Can anyone advise?

Private Sub Application_ItemSend(ByVal item As Object, Cancel As Boolean)
Dim retval
retval = FileSendingEmail(item)
End Sub

Function FileSendingEmail(MyMail As Object)
'------Dimension variables----------------
Dim ws As Workspace
Dim db As Database
Dim rst As Recordset
Dim rstlog As Recordset
Dim strID As String
Dim olNS As Outlook.NameSpace
Dim olMail As Outlook.MailItem
Dim utils, PR_SMTP_ADDRESS, SenderEMail
Dim SafeMail
Dim ID As Long
Dim StrPath As String

'-----Open databases-----------------------
DBEngine.SystemDB = "z:\secured.mdw"
Set ws = DBEngine.CreateWorkspace("New", "xxx", "xxx")
Set db = ws.OpenDatabase("Z:\data.mdb")
Set rst = db.OpenRecordset("Suppliers", dbOpenDynaset)
Set rstlog = db.OpenRecordset("Supplierlog", dbOpenDynaset)
'-------------------------------------------------

StrPath = "J:\Documents\"

strID = MyMail.EntryID
Set olNS = Application.GetNamespace("MAPI")
Set olMail = MyMail
'On Error GoTo 0
Set SafeMail = CreateObject("Redemption.SafemailItem")
SafeMail.item = olMail

Set utils = CreateObject("Redemption.MAPIUtils")
PR_SMTP_ADDRESS = &H39FE001E
SenderEMail = utils.HrGetOneProp(olMail.MAPIOBJECT, PR_SMTP_ADDRESS)

rst.FindFirst "Email = '" & SenderEMail & "'"

If Not rst.NoMatch Then
'do stuff
End if
end function

Any ideas?


Ken Slovak - [MVP - Outlook] January 29th 08 05:17 PM

Get smtp address on send
 
The sending properties aren't added to an item until after it's sent, then
they are added by the transport. If you want addresses earlier than that use
the Recipients collection of the item and iterate each Recipient object and
get the email addresses that way.

--
Ken Slovak
[MVP - Outlook]
http://www.slovaktech.com
Author: Professional Programming Outlook 2007
Reminder Manager, Extended Reminders, Attachment Options
http://www.slovaktech.com/products.htm


"dkgb" wrote in message
...
Hello,

I would like to save a copy of an email when it is sent if I can find the
SMTP address in a jet database. I have been successful (with the help of
this community) in getting the SMTP address of incoming messages using
Redemption and now I would like to get the addresses of outgoing messages.
However, in the code below, the email address is empty. Can anyone
advise?

Private Sub Application_ItemSend(ByVal item As Object, Cancel As Boolean)
Dim retval
retval = FileSendingEmail(item)
End Sub

Function FileSendingEmail(MyMail As Object)
'------Dimension variables----------------
Dim ws As Workspace
Dim db As Database
Dim rst As Recordset
Dim rstlog As Recordset
Dim strID As String
Dim olNS As Outlook.NameSpace
Dim olMail As Outlook.MailItem
Dim utils, PR_SMTP_ADDRESS, SenderEMail
Dim SafeMail
Dim ID As Long
Dim StrPath As String

'-----Open databases-----------------------
DBEngine.SystemDB = "z:\secured.mdw"
Set ws = DBEngine.CreateWorkspace("New", "xxx", "xxx")
Set db = ws.OpenDatabase("Z:\data.mdb")
Set rst = db.OpenRecordset("Suppliers", dbOpenDynaset)
Set rstlog = db.OpenRecordset("Supplierlog", dbOpenDynaset)
'-------------------------------------------------

StrPath = "J:\Documents\"

strID = MyMail.EntryID
Set olNS = Application.GetNamespace("MAPI")
Set olMail = MyMail
'On Error GoTo 0
Set SafeMail = CreateObject("Redemption.SafemailItem")
SafeMail.item = olMail

Set utils = CreateObject("Redemption.MAPIUtils")
PR_SMTP_ADDRESS = &H39FE001E
SenderEMail = utils.HrGetOneProp(olMail.MAPIOBJECT, PR_SMTP_ADDRESS)

rst.FindFirst "Email = '" & SenderEMail & "'"

If Not rst.NoMatch Then
'do stuff
End if
end function

Any ideas?



dkgb February 9th 08 06:49 PM

Get smtp address on send
 
Thanks Ken,

I've tried that but it does not necessarily give me the SMTP address. I
need the SMPT address to look someting up in an Access database. Any other
suggestions? I think there must be a way using Redemption.

"Ken Slovak - [MVP - Outlook]" wrote:

The sending properties aren't added to an item until after it's sent, then
they are added by the transport. If you want addresses earlier than that use
the Recipients collection of the item and iterate each Recipient object and
get the email addresses that way.

--
Ken Slovak
[MVP - Outlook]
http://www.slovaktech.com
Author: Professional Programming Outlook 2007
Reminder Manager, Extended Reminders, Attachment Options
http://www.slovaktech.com/products.htm


"dkgb" wrote in message
...
Hello,

I would like to save a copy of an email when it is sent if I can find the
SMTP address in a jet database. I have been successful (with the help of
this community) in getting the SMTP address of incoming messages using
Redemption and now I would like to get the addresses of outgoing messages.
However, in the code below, the email address is empty. Can anyone
advise?

Private Sub Application_ItemSend(ByVal item As Object, Cancel As Boolean)
Dim retval
retval = FileSendingEmail(item)
End Sub

Function FileSendingEmail(MyMail As Object)
'------Dimension variables----------------
Dim ws As Workspace
Dim db As Database
Dim rst As Recordset
Dim rstlog As Recordset
Dim strID As String
Dim olNS As Outlook.NameSpace
Dim olMail As Outlook.MailItem
Dim utils, PR_SMTP_ADDRESS, SenderEMail
Dim SafeMail
Dim ID As Long
Dim StrPath As String

'-----Open databases-----------------------
DBEngine.SystemDB = "z:\secured.mdw"
Set ws = DBEngine.CreateWorkspace("New", "xxx", "xxx")
Set db = ws.OpenDatabase("Z:\data.mdb")
Set rst = db.OpenRecordset("Suppliers", dbOpenDynaset)
Set rstlog = db.OpenRecordset("Supplierlog", dbOpenDynaset)
'-------------------------------------------------

StrPath = "J:\Documents\"

strID = MyMail.EntryID
Set olNS = Application.GetNamespace("MAPI")
Set olMail = MyMail
'On Error GoTo 0
Set SafeMail = CreateObject("Redemption.SafemailItem")
SafeMail.item = olMail

Set utils = CreateObject("Redemption.MAPIUtils")
PR_SMTP_ADDRESS = &H39FE001E
SenderEMail = utils.HrGetOneProp(olMail.MAPIOBJECT, PR_SMTP_ADDRESS)

rst.FindFirst "Email = '" & SenderEMail & "'"

If Not rst.NoMatch Then
'do stuff
End if
end function

Any ideas?




Ken Slovak - [MVP - Outlook] February 9th 08 11:03 PM

Get smtp address on send
 
If you're using Redemption then RDOAddressEntry has an SMTPAddress property.
So does Redemption.AddressEntry. Use either RDORecipient.AddressEntry or
Recipient.AddressEntry to get the AddressEntry objects.
--
Ken Slovak
[MVP - Outlook]
http://www.slovaktech.com
Author: Professional Programming Outlook 2007
Reminder Manager, Extended Reminders, Attachment Options
http://www.slovaktech.com/products.htm


"dkgb" wrote in message
...
Thanks Ken,

I've tried that but it does not necessarily give me the SMTP address. I
need the SMPT address to look someting up in an Access database. Any
other
suggestions? I think there must be a way using Redemption.



dkgb February 13th 08 07:20 AM

Get smtp address on send
 
I'm still struggling with this. Here is a code snippet. The comments detail
the the issues I am having with addressentry and SMTPAddress:

Function FileSendingEmail(MyMail As Object)
Dim strID As String
Dim olNS As Outlook.NameSpace
Dim olMail As Outlook.MailItem
Dim SafeMail
Dim SMTPAddress

strID = MyMail.EntryID
Set olNS = Application.GetNamespace("MAPI")
Set SafeMail = CreateObject("Redemption.SafemailItem")
SafeMail.item = myMail

SMTPAddress = SafeMail.Recipients(1).AddressEntry.SMTPAddress
‘Error “Index must be between 1 and count”

SMTPAddress = SafeMail.item.Recipients(1).AddressEntry.SMTPAddre ss
‘Generates security warning then error “object does not support this
property or method”


MsgBox SMTPAddress

End function


"Ken Slovak - [MVP - Outlook]" wrote:

If you're using Redemption then RDOAddressEntry has an SMTPAddress property.
So does Redemption.AddressEntry. Use either RDORecipient.AddressEntry or
Recipient.AddressEntry to get the AddressEntry objects.
--
Ken Slovak
[MVP - Outlook]
http://www.slovaktech.com
Author: Professional Programming Outlook 2007
Reminder Manager, Extended Reminders, Attachment Options
http://www.slovaktech.com/products.htm


"dkgb" wrote in message
...
Thanks Ken,

I've tried that but it does not necessarily give me the SMTP address. I
need the SMPT address to look someting up in an Access database. Any
other
suggestions? I think there must be a way using Redemption.




Ken Slovak - [MVP - Outlook] February 13th 08 04:27 PM

Get smtp address on send
 
I don't anywhere in that code where you actually add any recipients to the
message. Add at least one recipient and save the item then get it as a
SafeMailItem object. Try that and see if it helps.

--
Ken Slovak
[MVP - Outlook]
http://www.slovaktech.com
Author: Professional Programming Outlook 2007
Reminder Manager, Extended Reminders, Attachment Options
http://www.slovaktech.com/products.htm


"dkgb" wrote in message
...
I'm still struggling with this. Here is a code snippet. The comments
detail
the the issues I am having with addressentry and SMTPAddress:

Function FileSendingEmail(MyMail As Object)
Dim strID As String
Dim olNS As Outlook.NameSpace
Dim olMail As Outlook.MailItem
Dim SafeMail
Dim SMTPAddress

strID = MyMail.EntryID
Set olNS = Application.GetNamespace("MAPI")
Set SafeMail = CreateObject("Redemption.SafemailItem")
SafeMail.item = myMail

SMTPAddress = SafeMail.Recipients(1).AddressEntry.SMTPAddress
‘Error “Index must be between 1 and count”

SMTPAddress = SafeMail.item.Recipients(1).AddressEntry.SMTPAddre ss
‘Generates security warning then error “object does not support this
property or method”


MsgBox SMTPAddress

End function



dkgb February 13th 08 05:18 PM

Get smtp address on send
 
Ken,

Since the code is executing on the Application_ItemSend event after the user
creates the email and clicks send, I did not think I had to save the item or
resolve the recipients. I have added a save and it seems to have done the
trick!

Thank you for your help and patience!

Dave


"Ken Slovak - [MVP - Outlook]" wrote:

I don't anywhere in that code where you actually add any recipients to the
message. Add at least one recipient and save the item then get it as a
SafeMailItem object. Try that and see if it helps.

--
Ken Slovak
[MVP - Outlook]
http://www.slovaktech.com
Author: Professional Programming Outlook 2007
Reminder Manager, Extended Reminders, Attachment Options
http://www.slovaktech.com/products.htm


"dkgb" wrote in message
...
I'm still struggling with this. Here is a code snippet. The comments
detail
the the issues I am having with addressentry and SMTPAddress:

Function FileSendingEmail(MyMail As Object)
Dim strID As String
Dim olNS As Outlook.NameSpace
Dim olMail As Outlook.MailItem
Dim SafeMail
Dim SMTPAddress

strID = MyMail.EntryID
Set olNS = Application.GetNamespace("MAPI")
Set SafeMail = CreateObject("Redemption.SafemailItem")
SafeMail.item = myMail

SMTPAddress = SafeMail.Recipients(1).AddressEntry.SMTPAddress
‘Error “Index must be between 1 and count”

SMTPAddress = SafeMail.item.Recipients(1).AddressEntry.SMTPAddre ss
‘Generates security warning then error “object does not support this
property or method”


MsgBox SMTPAddress

End function




dkgb March 1st 08 05:33 PM

Get smtp address on send
 
I have a new problem with the code. On a particular address from my
contacts, I get the following error on this line of code:

SMTPAddress = SafeMail.Recipients(i).AddressEntry.SMTPAddress

?err
-2147418113
?error$
Method 'SMTPAddress' of object 'IAddressEntry' failed

Does anyone have any ideas what is causing it?

"dkgb" wrote:

Ken,

Since the code is executing on the Application_ItemSend event after the user
creates the email and clicks send, I did not think I had to save the item or
resolve the recipients. I have added a save and it seems to have done the
trick!

Thank you for your help and patience!

Dave


"Ken Slovak - [MVP - Outlook]" wrote:

I don't anywhere in that code where you actually add any recipients to the
message. Add at least one recipient and save the item then get it as a
SafeMailItem object. Try that and see if it helps.

--
Ken Slovak
[MVP - Outlook]
http://www.slovaktech.com
Author: Professional Programming Outlook 2007
Reminder Manager, Extended Reminders, Attachment Options
http://www.slovaktech.com/products.htm


"dkgb" wrote in message
...
I'm still struggling with this. Here is a code snippet. The comments
detail
the the issues I am having with addressentry and SMTPAddress:

Function FileSendingEmail(MyMail As Object)
Dim strID As String
Dim olNS As Outlook.NameSpace
Dim olMail As Outlook.MailItem
Dim SafeMail
Dim SMTPAddress

strID = MyMail.EntryID
Set olNS = Application.GetNamespace("MAPI")
Set SafeMail = CreateObject("Redemption.SafemailItem")
SafeMail.item = myMail

SMTPAddress = SafeMail.Recipients(1).AddressEntry.SMTPAddress
‘Error “Index must be between 1 and count”

SMTPAddress = SafeMail.item.Recipients(1).AddressEntry.SMTPAddre ss
‘Generates security warning then error “object does not support this
property or method”


MsgBox SMTPAddress

End function




Ken Slovak - [MVP - Outlook] March 3rd 08 02:45 PM

Get smtp address on send
 
Does that particular contact have an email address? Is it a properly
formatted SMTP address?

If you look at it with a MAPI viewer such as OutlookSpy (www.dimastr.com) or
MFCMAPI (free download from MS) do you see anything different with it
compared to other contacts that work?

Does the code always fail on that specific contact?

Does it help if you create a new contact with the same settings and try that
one?

--
Ken Slovak
[MVP - Outlook]
http://www.slovaktech.com
Author: Professional Programming Outlook 2007
Reminder Manager, Extended Reminders, Attachment Options
http://www.slovaktech.com/products.htm


"dkgb" wrote in message
...
I have a new problem with the code. On a particular address from my
contacts, I get the following error on this line of code:

SMTPAddress = SafeMail.Recipients(i).AddressEntry.SMTPAddress

?err
-2147418113
?error$
Method 'SMTPAddress' of object 'IAddressEntry' failed

Does anyone have any ideas what is causing it?




All times are GMT +1. The time now is 10:17 AM.

Powered by vBulletin® Version 3.6.4
Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Search Engine Friendly URLs by vBSEO 2.4.0
Copyright 2004-2006 OutlookBanter.com