VB代码保存Outlook邮件时主题含连续空格导致.msg保存报错问题

问题描述 #

• 代码构造邮件主题行并添加日期时间时，会在.msg文件扩展名前多出一段大空格。
• 当弹出消息框供检查保存位置时，如果不删除该空格，代码就会跳转到错误处理程序。
• 删除这段4-5个字符长度的空格后，文件就能正常保存。

原运行代码

Dim oMail As Outlook.MailItem
Dim objItem As Object
Dim atch As Attachment
Dim sPath, strFolderPath As String
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim answer As String
Dim dtDate As Date
Dim sName As String
Dim enviro As String
Dim jobNumber As String
On Error GoTo errHandler
enviro = CStr(Environ("USERPROFILE"))
jobNumber = InputBox("Please enter job number", "Saving to Job Folder", "Enter Job Number Here")

If jobNumber = "" Then Exit Sub
'create default name for saving file
If IsNumeric(jobNumber) Then
    strFile = Int(jobNumber / 100) & "00-" & Int(jobNumber / 100) & "99\" & jobNumber & "\"
Else
    strFile = ""
End If
strPathFile = "\\vacdc\VCI JOBS\" & strFile

If Dir(strPathFile, vbDirectory) = vbNullString Then
    strFile = Int(jobNumber / 100) & "00-" & Int(jobNumber / 100) & "99\"
    strPathFile = "\\vacdc\VCI JOBS\" & strFile
End If

answer = MsgBox(strPathFile, vbYesNoCancel + vbQuestion, "Save emails here?")
If answer = vbYes Then
    sPath = strPathFile
Else
    If answer = vbCancel Then GoTo exitHandler
    strFolderPath = BrowseForFolder("\\vacdc\VCI JOBS\")
    sPath = strFolderPath & "\"
End If

For Each objItem In ActiveExplorer.Selection
    If objItem.MessageClass = "IPM.Note" Then
        Set oMail = objItem
        sName = oMail.Subject
        ReplaceCharsForFileName sName, "_"
        dtDate = oMail.ReceivedTime
        sName = Format(dtDate, " mm-dd-yyyy", vbUseSystemDayOfWeek, _
          vbUseSystem) & " " & sName & ".msg"
        sName = InputBox("", "", sName)
        Debug.Print sPath & sName
        oMail.SaveAs sPath & sName, olMSG

调用的子例程代码

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, ":", 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

问题原因 #

多余空格来自两个位置：

1. 邮件主题oMail.Subject本身首尾带有常规空格、制表符或不间断空格等空白字符，未经过修剪就直接拼接进文件名
2. 日期格式化字符串开头额外加了一个空格，和后续拼接主题前的空格叠加，再加上主题末尾的空白，就会累积出现在.msg扩展名前

修复方案 #

修改文件名构造逻辑，对所有参与拼接的字符串做首尾空白修剪，确认主体内容无误后再加扩展名：
找到原代码中构造文件名的片段，替换为以下内容即可：

' 先修剪邮件主题首尾的常规空白与特殊不可见空白
sName = Trim$(oMail.Subject)
sName = Replace(sName, Chr(160), "") ' 移除Outlook常见的不间断空格
ReplaceCharsForFileName sName, "_"

dtDate = oMail.ReceivedTime
' 拼接日期和主题后整体修剪首尾空白，再添加扩展名
Dim baseName As String
baseName = Trim$(Format$(dtDate, "mm-dd-yyyy", vbUseSystemDayOfWeek, vbUseSystem) & " " & sName)
sName = baseName & ".msg"

该修改只会移除文件名首尾的多余空白，不会影响文件名中间需要保留的空格。

内容的提问来源于stack exchange，提问作者user3523983