如果主题带有星号，则 Outlook 电子邮件存档宏不起作用 [英] Outlook Email Archiving Macro Doesnt work if subject has asterisk

问题描述

我正在使用以下代码将我的电子邮件存档到指定的文件夹中，该文件夹目前运行良好......除非电子邮件主题包含 *......然后给出调试消息运行时错误"-2147286788 (800300fc)'

I am using the following code to archive my emails to a designated folder which works perfectly at the moment.... UNLESS the email subject contains an *... this then gives a debug message "run-time error '-2147286788 (800300fc)'

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

Is there anything I can add into the below code to make it ignore or replace the * to something else to allow it to automatically archive these emails?

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

推荐答案

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

Remove all the Replaces and add in this instead (changing characters as necessary) -

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 电子邮件存档宏不起作用的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！