VBA导入Outlook邮件宏遇特殊字符主题触发1004运行时错误

错误根源 #

你遇到的运行时错误'1004'主要由两个原因导致：

• 以=?ANSI_X3.4-1968?Q?开头的内容是MIME编码的邮件头，解码后可能包含Excel单元格不支持的不可见控制字符，直接写入会触发报错
• 原代码未显式绑定单元格对应的工作表，操作过程中如果活动工作表切换也会触发该错误，同时存在未声明变量、变量未赋值就使用的隐患

修复步骤 #

1. 新增字符串清洗函数，过滤掉文本中的不可见控制字符，适配特殊编码邮件内容的处理
2. 所有单元格操作统一绑定你定义的sh工作表对象，避免活动工作表切换带来的异常
3. 补充变量声明，修正未赋值变量的逻辑问题

修复后完整代码 #

Option Explicit ' 强制变量声明，提前捕获语法错误

' 字符串清洗辅助函数：过滤不可见控制字符
Function CleanString(str As Variant) As String
    Dim i As Long
    Dim result As String
    If IsNull(str) Or IsEmpty(str) Then
        CleanString = ""
        Exit Function
    End If
    result = CStr(str)
    ' 过滤ASCII码0-31的控制字符
    For i = 1 To 31
        result = Replace(result, Chr(i), "")
    Next i
    ' 额外过滤DEL等特殊不可见字符
    result = Replace(result, Chr(127), "")
    CleanString = result
End Function

Sub search_inbox()
    Dim ol As Outlook.Application
    Dim ns As Outlook.Namespace
    Dim fol As Outlook.Folder
    Dim i As Object
    Dim mi As Outlook.MailItem
    Dim START_DATE As Date
    Dim END_DATE As Date 
    Dim n As Long 
    Dim sh As Worksheet
    
    Set sh = ThisWorkbook.Sheets("Test")
    sh.Range("A2:F60").ClearContents ' 匹配实际写入的列范围统一清理
    
    Set ol = New Outlook.Application
    Set ns = ol.GetNamespace("MAPI")
    Set fol = ns.Folders(sh.Range("M1").Value).Folders(sh.Range("M2").Value)
    
    START_DATE = sh.Range("J8") + sh.Range("J9")
    END_DATE = sh.Range("K8") + sh.Range("K9")
    
    n = 0 ' 初始化计数变量
    For Each i In fol.Items
        If i.SentOn >= START_DATE And i.SentOn <= END_DATE And i.Class = olMail Then
            n = n + 1
            Set mi = i
            ' 所有单元格操作绑定sh对象，文本类内容先经过清洗再写入
            sh.Cells(n + 1, 1).Value = CleanString(mi.SenderName)
            sh.Cells(n + 1, 2).Value = CleanString(mi.Subject)
            sh.Cells(n + 1, 3).Value = CleanString(mi.SenderEmailAddress)
            sh.Cells(n + 1, 4).Value = mi.ReceivedTime
            sh.Cells(n + 1, 5).Value = CleanString(mi.Categories)
            sh.Cells(n + 1, 6).Value = mi.Size
        End If
    Next i
    
    MsgBox "共导入 " & n & " 条邮件记录"
End Sub

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