我正在使用以下代码将我的电子邮件存档到目前完美运行的指定文件夹...除非电子邮件主题包含 *...然后这会给出调试消息“运行时错误”- 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
最佳答案
删除所有替换并添加(根据需要更改字符)-
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
关于vba - 如果主题带有星号,Outlook 电子邮件存档宏将不起作用,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/36474383/