VBA生成Outlook邮件时在rng赋值行触发Runtime error '91'报错求助

运行时错误91本质是对象变量未完成实例化/赋值就被调用，原代码一共存在4个直接触发错误或隐藏问题：

• 错误的变量引用逻辑：VBA不支持通过"rng" & i拼接字符串的方式直接调用同名的Range对象变量，且rng是对象类型，赋值必须加Set关键字，直接给对象变量赋字符串必然触发类型不匹配、对象未赋值错误。
• 变量名拼写错误：循环内创建Outlook实例时写的是Outappp（多写了一个p），和之前声明的OutApp不是同一个变量，后续调用OutApp.CreateItem时OutApp实际是空值，也会触发91错误。
• 资源浪费问题：把Outlook实例创建放在循环内，每生成一封邮件就新建一个Outlook进程，完全没必要还容易造成后台进程残留。
• 依赖函数缺失：代码调用了RangetoHTML函数但没有提供实现，就算前面的错误修复，运行时也会报“子过程或函数未定义”错误。

Sub generate4emails()
    Dim OutApp As Object, OutMail As Object
    Dim i As Integer
    Dim rng As Range, rng1 As Range, rng2 As Range, rng3 As Range, rng4 As Range

    ' 预定义4封邮件要插入的表格区域
    Set rng1 = ThisWorkbook.Sheets("Sheet1").Range("C12:F14")
    Set rng2 = ThisWorkbook.Sheets("Sheet1").Range("C16:F18")
    Set rng3 = ThisWorkbook.Sheets("Sheet1").Range("H12:K14")
    Set rng4 = ThisWorkbook.Sheets("Sheet1").Range("H16:K18")

    ' 循环外一次性创建Outlook实例，避免重复启动进程
    Set OutApp = CreateObject("Outlook.Application")

    For i = 1 To 4
        ' 按序号匹配对应区域，替代错误的字符串拼接引用逻辑
        Set rng = Choose(i, rng1, rng2, rng3, rng4)
        Set OutMail = OutApp.CreateItem(0)
        
        With OutMail
            .To = ThisWorkbook.Sheets("Sheet1").Range("A1").Value
            .Subject = "Notice" & i
            .HTMLBody = RangetoHTML(rng)
            .Display
        End With
        Set OutMail = Nothing
    Next i

    ' 释放对象资源
    Set OutApp = Nothing
End Sub

' 通用Range转HTML工具函数，将Excel单元格区域转换为Outlook可正常渲染的HTML格式
Function RangetoHTML(rng As Range) As String
    Dim fso As Object, ts As Object, TempFile As String, TempWB As Workbook
    TempFile = Environ$("temp") & "\" & Format(Now, "ddmmyyhhmmss") & ".htm"
    
    rng.Copy
    Set TempWB = Workbooks.Add(1)
    With TempWB.Sheets(1)
        .Cells(1, 1).PasteSpecial Paste:=8
        .Cells(1, 1).PasteSpecial xlPasteValues
        .Cells(1, 1).PasteSpecial xlPasteFormats
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With
    
    With TempWB.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         Filename:=TempFile, _
         Sheet:=TempWB.Sheets(1).Name, _
         Source:=TempWB.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
    RangetoHTML = ts.ReadAll
    ts.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", "align=left x:publishsource=")
    
    TempWB.Close savechanges:=False
    Kill TempFile
    
    Set ts = Nothing
    Set fso = Nothing
    Set TempWB = Nothing
End Function

• 修正了拼写错误的OutApp变量名，保证Outlook实例正常创建。
• 用Choose()函数按循环序号匹配预先定义的4个Range对象，给rng赋值时保留对象变量必须的Set关键字，解决核心的91报错问题。
• 把Outlook实例创建移到循环外，减少不必要的资源开销，避免后台残留Outlook进程。
• 补全了RangetoHTML实现函数，保证单元格区域的格式、内容可以正常嵌入邮件正文，不会出现格式丢失或函数未定义错误。

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