从电子邮件中检索发件人姓名

时间:2019-12-20 10:16:39

标签: outlook-vba

我想将选择的电子邮件连同发件人名称,日期和消息复制到特定文件夹中。

我在此站点上找到了代码。它将电子邮件保存到特定的文件夹,但发件人姓名显示为四位数(0941)。

示例
20191219- 0941 -FW_邮件主题

Option Explicit
Public Sub SaveMessageAsMsg()
Dim oMail As Outlook.MailItem
Dim objItem As Object
Dim sPath As String
Dim dtDate As Date
Dim sName As String
Dim enviro As String
**Dim sSenderName As String
Dim sSenderEmailAddress As String**
enviro = CStr(Environ("USERPROFILE"))
For Each objItem In ActiveExplorer.Selection
Set oMail = objItem
sName = oMail.Subject
ReplaceCharsForFileName sName, "_"
dtDate = oMail.ReceivedTime
sName = Format(dtDate, "yyyymmdd", vbUseSystemDayOfWeek, _
        vbUseSystem) & Format(dtDate, "-hhnn", _
        vbUseSystemDayOfWeek, vbUseSystem) & "-" & **sSenderName** & "-" & sName & ".msg"
        sPath = "C:\TEST\JV Approval Backup\"
Debug.Print sPath & sName
oMail.SaveAs sPath & sName, olMSG
Next
End Sub
Private Sub ReplaceCharsForFileName(sName As String, _
sChr As String _
)
sName = Replace(sName, "/", sChr)
sName = Replace(sName, "\", sChr)
sName = Replace(sName, ":", sChr)
sName = Replace(sName, "?", sChr)
sName = Replace(sName, Chr(34), sChr)
sName = Replace(sName, "<", sChr)
sName = Replace(sName, ">", sChr)
sName = Replace(sName, "|", sChr)
sName = Replace(sName, "@", sChr)
End Sub

1 个答案:

答案 0 :(得分:0)

尽管您有用于保存发件人姓名和发件人电子邮件地址的变量,但是您不会将值复制到这些变量中。我假设您认为发件人姓名的四位数是时间。

有三个发件人属性可供选择:.Sender.SenderEmailAddress.SenderName.SenderEmailAddress始终是电子邮件地址。 .Sender几乎总是一个友好名称,例如John Smith,但偶尔也与.SenderEmailAddress相同。 .SenderName通常与.Sender相同,但有时与.SenderEmailAddress相同。

(1)我建议您替换:

Dim sSenderName As String
Dim sSenderEmailAddress As String

作者

Dim sSender As String  

(2)添加您喜欢的以下任意一项:

sSender = oMail.Sender
sSender = oMail.SenderName
sSender = oMail.SenderEmailAddress

(3)替换:

sName = Format(dtDate, "yyyymmdd", vbUseSystemDayOfWeek, _ vbUseSystem) & Format(dtDate, "-hhnn", _ vbUseSystemDayOfWeek, vbUseSystem) & "-" & **sSenderName** & "-" & sName & ".msg"

作者

sName = Format(dtDate, "yyyymmdd"-hhnn") & "-" & sSender & "-" & sName & ".msg"

请尝试上述操作,如果未提供您想要的结果,请进行报告。