D
dkgb
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?
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?