时间戳

首页 > 解决方案 > 从电子邮件中检索发件人姓名

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

标签： vbaoutlook

解决方案

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

有三个发件人属性可供选择： .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"

尝试上述方法并报告，如果它没有给出您寻求的结果。

推荐阅读