保存带有发件人姓名首字母的电子邮件 [英] Saving emails with sender's initials
问题描述
我正在尝试将电子邮件保存为 .msg 文件.
I am trying to save emails as .msg files.
我正在使用以下代码,导致文件名格式为yyyy-mm-dd - sender - title.msg".我需要发件人的姓名首字母而不是全名.
I am using the following code, resulting in the filename format "yyyy-mm-dd - sender - title.msg". I need the sender's initials instead of the whole name.
Sub OpenAndSave()
Const SAVE_TO_FOLDER = "C:\Users\Documents\Emails\"
Dim olkMsg As Outlook.MailItem, intCount As Integer
intCount = 1
For Each olkMsg In Outlook.ActiveExplorer.Selection
strDate = Format(olkMsg.ReceivedTime, "yyyy-mm-dd - ")
olkMsg.Display
olkMsg.SaveAs SAVE_TO_FOLDER & strDate & RemoveIllegalCharacters(olkMsg.senderName) & " - " & RemoveIllegalCharacters(olkMsg.Subject) & ".msg"
olkMsg.Close olDiscard
Next
Set olkMsg = Nothing
End Sub
Function RemoveIllegalCharacters(strValue As String) As String
' Purpose: Remove characters that cannot be in a filename from a string.'
RemoveIllegalCharacters = strValue
RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, "<", "")
RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, ">", "")
RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, ":", "")
RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, Chr(34), "'")
RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, "/", "")
RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, "\", "")
RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, "|", "")
RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, "?", "")
RemoveIllegalCharacters = Replace(RemoveIllegalCharacters, "*", "")
End Function
例如今天来自约翰 A 史密斯的电子邮件:2019-10-23 - JAS - 主题"或昨天来自凯文毕晓普的电子邮件:2019-10-22 - KB - 主题"
E.g. email from John A Smith today: "2019-10-23 - JAS - Subject" Or email from Kevin Bishop yesterday: "2019-10-22 - KB - Subject"
推荐答案
你可以使用这样的辅助函数来返回发件人姓名的首字母:
You could use a helper function like this perhaps to return the initials from the sender name:
Private Function Initials(ByVal fullName As String) As String
Dim splitName
splitName = Split(fullName)
Dim i As Long
For i = LBound(splitName) To UBound(splitName)
Initials = UCase$(Initials & IIf(Len(splitName(i) > 0), Left$(splitName(i), 1), ""))
Next
End Function
可以这样称呼它:
olkMsg.SaveAs SAVE_TO_FOLDER & strDate & RemoveIllegalCharacters(Initials(olkMsg.senderName))...
虽然我会将其分解为多个部分以提高可读性.
though I would break that up into multiple pieces for readability.
您可能可以将 Initials = ...
行简化为:
You can probably simplify the Initials = ...
line to:
Initials = UCase$(Initials & Left$(splitName(i), 1))
这篇关于保存带有发件人姓名首字母的电子邮件的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!