我正在努力让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
答案 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