Question

我正在使用以下代码将我的电子邮件归档到指定的文件夹，该文件夹目前运行正常....除非电子邮件主题包含* ...这然后给出调试消息“运行时错误” - 2147286788（800300fc）'

我是否可以在下面的代码中添加任何内容以使其忽略或将*替换为其他内容以允许其自动存档这些电子邮件？

Option Explicit

Public Sub Received2016()

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

enviro = CStr(Environ("USERPROFILE"))

For Each objItem In ActiveExplorer.Selection

Set oMail = objItem

sName = oMail.Subject

ReplaceCharsForFileName sName, "_"

dtDate = oMail.ReceivedTime

sName = Format(dtDate, "yyyy-mm-dd - ", vbUseSystemDayOfWeek, _

vbUseSystem) & Format(dtDate, "hh-nn-ss", _

vbUseSystemDayOfWeek, vbUseSystem) & " - " & sName & ".msg"

sPath = "H:\Email Archive\2016 Emails\Received\"

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)

End Sub

Answer 1

删除所有替换并添加替换（根据需要更改字符） -

sName = RemoveSpecials(sName)

Function RemoveSpecials(strInput As String) As String
    Dim strChars As String
    strChars = "!£$%^&*()_+{}@~:<>?,./;'#[]-=`¬¦" & Chr(34)
    Dim intIndex As Integer
    For intIndex = 1 To Len(strChars)
        strInput = Replace(strInput, Mid(strChars, intIndex, 1), "")
    Next
    RemoveSpecials = strInput
End Function

Outlook电子邮件归档宏如果主题带有星号，则无效

1 个答案: