P
Pamela via AccessMonster.com
Hello;
I have added a section to my database application which allows users to
attach highlighted emails in Outlook. All works great except that I was
wondering how to extract the sender's email address or header information
from Outlook? I can get the sender's name, but would like to be able to
include their actual email address as well. Here is the code:
For Each itm In sel
If itm.Class = olMail Then
Set msg = itm
rstMail.AddNew
DoCmd.Hourglass True
'MsgBox ("record = ") & Forms!frmCorrespondence.ID
rstMail![CorrespID] = Forms!frmCorrespondence.ID
rstMail![From] = msg.SenderName
rstMail![Subject] = msg.Subject
rstMail![CC] = msg.CC
rstMail![BCC] = msg.BCC
rstMail![Sent] = msg.CreationTime
rstMail![Body] = msg.Body
lngMessageID = rstMail![MessageID]
rstMail.Update 'update Mail Messages Table
'''''''''''''''''''''''''''''''''''''''''''''''''''
'Work with mail message's Attachments collection
If msg.Attachments.Count > 0 Then
For Each att In msg.Attachments
rstAtts.AddNew 'add new record
strAttFile = strAttsPath & att.FileName
Msg2 = "Save File " & att.FileName & " To:" & strAttFile & "?"
Response = MsgBox(Msg2, vbYesNo, "Save Attachment?")
If Response = vbNo Then GoTo Continue 'do not save attachment
'Process attachments
att.SaveAsFile strAttFile
strHyperlink = Chr$(35) & strAttFile & Chr$(35)
rstAtts![MessageID] = lngMessageID
rstAtts![Attachment] = strHyperlink
rstAtts.Update
Continue: Next att 'process next attachment
End If
'''''''''''''''''''''''''''''''''''''''''''''''''''''
End If
Next itm
I have added a section to my database application which allows users to
attach highlighted emails in Outlook. All works great except that I was
wondering how to extract the sender's email address or header information
from Outlook? I can get the sender's name, but would like to be able to
include their actual email address as well. Here is the code:
For Each itm In sel
If itm.Class = olMail Then
Set msg = itm
rstMail.AddNew
DoCmd.Hourglass True
'MsgBox ("record = ") & Forms!frmCorrespondence.ID
rstMail![CorrespID] = Forms!frmCorrespondence.ID
rstMail![From] = msg.SenderName
rstMail![Subject] = msg.Subject
rstMail![CC] = msg.CC
rstMail![BCC] = msg.BCC
rstMail![Sent] = msg.CreationTime
rstMail![Body] = msg.Body
lngMessageID = rstMail![MessageID]
rstMail.Update 'update Mail Messages Table
'''''''''''''''''''''''''''''''''''''''''''''''''''
'Work with mail message's Attachments collection
If msg.Attachments.Count > 0 Then
For Each att In msg.Attachments
rstAtts.AddNew 'add new record
strAttFile = strAttsPath & att.FileName
Msg2 = "Save File " & att.FileName & " To:" & strAttFile & "?"
Response = MsgBox(Msg2, vbYesNo, "Save Attachment?")
If Response = vbNo Then GoTo Continue 'do not save attachment
'Process attachments
att.SaveAsFile strAttFile
strHyperlink = Chr$(35) & strAttFile & Chr$(35)
rstAtts![MessageID] = lngMessageID
rstAtts![Attachment] = strHyperlink
rstAtts.Update
Continue: Next att 'process next attachment
End If
'''''''''''''''''''''''''''''''''''''''''''''''''''''
End If
Next itm