用于保存Outlook的电子邮件的宏 - 获取发件人的姓氏

时间:2016-06-28 12:15:56

标签: vba outlook outlook-vba

我正在努力让Outlook宏工作,只是将电子邮件保存为.msg文件,具有特定格式,以便存档。

类似于这里的另一个用户,我正在使用以下代码,产生文件格式" yymmdd_sender_title.msg",这正是我想要的,除了我需要获取发件人& #39;仅姓氏,而不是全名。

非常感谢任何帮助!

谢谢。

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

enviro = CStr(Environ("USERPROFILE"))
For Each objItem In ActiveExplorer.Selection
If objItem.MessageClass = "IPM.Note" Then
Set oMail = objItem

sName = oMail.subject
ReplaceCharsForFileName sName, ""


sSenderName = oMail.SenderName
dtDate = oMail.ReceivedTime
sName = Format(dtDate, "yymmdd", vbUseSystemDayOfWeek, _
vbUseSystem) & "_" & sSenderName & "_" & sName & ".msg"

sPath = enviro & "\Documents\"
Debug.Print sPath & sName
oMail.SaveAs sPath & sName, olMSG

End If
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, ":", sChr)
sName = Replace(sName, "?", sChr)
sName = Replace(sName, Chr(34), sChr)
sName = Replace(sName, "<", sChr)
sName = Replace(sName, ">", sChr)
sName = Replace(sName, "|", sChr)
End Sub

2 个答案:

答案 0 :(得分:0)

如果地址条目详细信息来自(AddressEntry.GetExchnageUserUser()上的同一台Exchange服务器,则只能检索地址条目详细信息。否则显示名称就是你得到的全部。

答案 1 :(得分:0)

尝试使用Split Function

实施例

    sSenderName = oMail.SenderName

    sSenderName = Split(sSenderName, " ")(1) 

然后是你的其余代码

How to split Full Name field into First Name, Last Name and Middle Initial

Extracting First And Last Names