当发送的邮件保存到本地文件夹时，删除主题行中的非法字符

Question

我需要将我发送的每封邮件保存到本地文件夹中。(然后每月存档)

我有工作的代码，除非有非法字符在主题行。我试着插入代码来去除非法字符，但总是把它搞砸。

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Call SaveACopy(Item)
End Sub

Sub SaveACopy(Item As Object)
Const olMsg As Long = 3
Dim m As MailItem
Dim savePath As String
Dim sSenderEmailAddress As String

If TypeName(Item) <> "MailItem" Then Exit Sub
Set m = Item
savePath = "C:UsersEmail-SENT"
savePath = savePath & Format(Now(), "(yy.mm.dd-hh.NN ss) - ") & m.Subject & " (T) " & m.To
savePath = savePath & ".msg"
m.SaveAs savePath, olMsg
End Sub

Answer 1

可以使用VBA中提供的与字符串相关的函数。例如，Replace函数返回一个字符串，该字符串是从开始位置(默认为1)开始的字符串表达式的子字符串，其中指定的子字符串已被另一个子字符串替换指定次数。Replace函数的返回值是一个经过替换的字符串，它从start指定的位置开始，并在表达式字符串的末尾结束。它不是从头到尾的原始字符串的副本。因此，您可以去掉任何非法字符。

我还建议处理Items类的ItemAdd(来自Sent Items文件夹)。当项目提交但实际未发送时触发ItemSend事件。因此，任何其他处理ItemSend事件的软件都可以通过将Cancel参数设置为true来取消任何进一步的处理。但是，当邮件在Outlook中发出时，已发送的邮件将放在已发送邮件文件夹中。实际上，如果你设置SaveSentMessageFolder属性，它可以是任何文件夹，该属性设置了一个Folder对象，该对象表示发送电子邮件消息副本将保存在其中的文件夹。例如:

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim SentFolder As Folder
Dim desFolder As Folder

If TypeName(Item) = "MailItem" And Item.DeleteAfterSubmit = False Then
'Specify the sent emails
If InStr(Item.To, "shirley") > 0 Or InStr(LCase(Item.Subject), "test") > 0 Then
'Specify the folder for saving the sent emails
'You can change it as per your needs
Set SentFolder = Application.Session.GetDefaultFolder(olFolderSentMail)
Set desFolder = SentFolder.Folders("Test")
Set Item.SaveSentMessageFolder = desFolder
End If
End If
End Sub

那么，您可以将已发送的项保存到磁盘，而不是已提交但尚未发送的项。

Answer 2

请尝试下一个功能。它提供了用一个共同的合法字符替换所有非法字符的可能性。或者消除它们:

Function ReplaceIllegChars(strClean As String, strChar As String) As String
Dim strCharsToElim As String, i As Long, strSolved As String
strCharsToElim = "~""#%&*:<>,@?{|}/[]" & Chr(10) & Chr(13)
For i = 1 To Len(strCharsToElim)
strClean = Replace(strClean, Mid$(strCharsToElim, i, 1), strChar)
Next
ReplaceIllegChars = strClean
End Function

我不是上述函数的"父"…这是我前一段时间在网上找到的，根据我的需要添加了一些其他的字符和个性化。

您也可以在strCharsToElim中添加其他字符。

你可以用下面的方法测试它:

Sub testReplaceIllegChars()
Dim x As String, strCorrect As String
x = "<>,today,]|[%tomorrow?@/"
Debug.Print ReplaceIllegChars(x, "_")
Debug.Print ReplaceIllegChars(x, "") 'to only replace them...
strCorrect = ReplaceIllegChars(m.Subject, "_")
End Sub

为了在您的代码中使用它，请替换以下代码行:

savePath = savePath & Format(Now(), "(yy.mm.dd-hh.NN ss) - ") & m.Subject & " (T) " & m.To

:

Dim strCorrect As String
strCorrect = ReplaceIllegChars(m.Subject, "_")
savePath = savePath & Format(Now(), "(yy.mm.dd-hh.NN ss) - ") & strCorrect & " (T) " & m.To
'your existing code...