Excel VBA实现打开工作簿发邮件报Run-time error 13求助

你遇到的报错如下：

Run-Time 13: Type not matching（类型不匹配）

错误排查结果 #

导致类型不匹配的问题全部集中在EmailReminder宏内，共5处：

• 空对象判断逻辑错误：If TypeName(oExpl) = "Nothing" Then语法不成立，VBA判断对象为空应使用Is关键字，该写法要么判断永远不生效，要么直接触发类型错误
• 列索引非法：你以Range("E1")为父对象调用Cells(i, -4)，列参数为负数超出合法范围，直接触发索引错误和类型转换错误
• Outlook常量拼写错误：创建邮件项的常量应为olMailItem，你写的oIMailItem属于未定义变量，传参时类型不匹配
• 邮件属性赋值语法错误：你将.Body的赋值逻辑直接拼接在.Subject的字符串赋值语句中，语法完全错误，触发类型转换失败
• 日期转换无校验：dDate = .Cells(i, 1)直接读取单元格内容转日期，如果单元格为空、内容为非日期格式文本，直接触发类型不匹配

修复方案 #

分步修改要点 #

1. 替换空对象判断语句为If oExpl Is Nothing Then
2. 所有单元格引用取消相对E1的负索引写法，直接使用工作表对象+列号/列名引用
3. 将oIMailItem替换为olMailItem，无引用时可直接写数值0
4. 拆分Subject、Body、Send为独立语句，不要用冒号强行拼接
5. 给日期赋值增加IsDate类型校验，跳过非法格式的行

修复后完整代码 #

Sub Auto_Open()
    Dim vResp As Variant, dTime As Date
    vResp = MsgBox("是否立即发送邮件?", vbYesNo)
    If vResp = 6 Then 'YES
        Call EmailReminder
    ElseIf vResp = 7 Then 'NO
        dTime = CDate(InputBox("请输入邮件发送时间:", , Time + TimeValue("00:00:10")))
        ' 替换等于判断为大于等于，避免时间精度问题导致死循环
        Do Until Time >= dTime
            DoEvents
        Loop
        Call EmailReminder
    End If
End Sub
    
Sub EmailReminder()
    Dim oOL As Outlook.Application, oMail As Outlook.MailItem, oNS As Outlook.Namespace
    Dim oMapi As Outlook.MAPIFolder, oExpl As Outlook.Explorer
    Dim sBody As String, dDate As Date
    Dim oWS As Worksheet, r As Long, i As Long, sStart As String
    
    Set oWS = Foglio1
    Set oOL = New Outlook.Application
    Set oExpl = oOL.ActiveExplorer
    
    ' 修正空对象判断逻辑
    If oExpl Is Nothing Then
        Set oNS = oOL.GetNamespace("MAPI")
        Set oMapi = oNS.GetDefaultFolder(olFolderInbox)
        Set oExpl = oMapi.GetExplorer
    End If
    
    r = oWS.Range("E1").CurrentRegion.Rows.Count
    For i = 1 To r
        ' 增加日期格式校验
        If Not IsDate(oWS.Cells(i, "E").Value) Then
            GoTo NextRow
        End If
        dDate = CDate(oWS.Cells(i, "E").Value)
        ' 假设姓名放在A、B列，可根据实际表格调整列名
        sBody = "今天是 " & oWS.Cells(i, "A").Value & " " & oWS.Cells(i, "B").Value & " 的生日，生日日期：" & dDate & vbCrLf & "大家一起送上祝福吧！"
        If Date = Int(dDate) Then ' 直接取整去掉时间部分，冗余判断可以删除
            Set oMail = oOL.CreateItem(olMailItem) ' 报错的话替换为0
            With oMail
                .Recipients.Add "umberto.roselli@openfiber.it" '收件人地址
                .Subject = "今日生日提醒：" & oWS.Cells(i, "A").Value & " " & oWS.Cells(i, "B").Value
                .Body = sBody
                .Send
            End With
        End If
NextRow:
    Next i
    MsgBox "提醒邮件已全部发送成功！"
End Sub

额外注意事项 #

• 需要先在VBA编辑器的「工具-引用」中勾选Microsoft Outlook XX.X Object Library，否则Outlook相关对象会报错
• 表格中E列必须为标准日期格式，姓名对应列可根据你的实际表格结构调整代码中的列名

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