使用富文本格式将单元格从 Excel 粘贴到 Outlook 时，为什么会出现运行时错误 4605？

Question

我正在尝试构建一个宏，为本周工作簿中的每个销售代表获取 AR 报告，并将每个工作表导出到新电子邮件中。每个销售代表都有一张工作表，以他们的姓名缩写命名，专用于他们，并且工作表选项卡按工作簿内这些缩写的字母顺序排序（AB 是工作表 1，BC 是工作表 2，CD 是工作表 3，等等）。 、、

这是我在这个宏之前编辑的过程；

• QuickBooks 将 AR 工作表从当前范围导出到最旧的范围：“当前、1-30、31-60、61-90、>90”

• 一些表格按公司字母顺序排列，而不是按账龄范围排列

  • BC 的工作表中有一些列被删除，原因只有在我之前的人知道。

• 所有表格都会粘贴到每位代表的电子邮件中。每个代表每封电子邮件一张。

  • 如果工作表未按字母顺序重新排序，则需要以相反的顺序粘贴日期范围：“">90、61-90、31-60、1-30、当前”

• 这些还需要粘贴为“富文本格式”，原因我不知道，而不仅仅是标准粘贴。

我已经得到了这段代码，它可以成功复制和粘贴，直到某一点为止。

这是我当前的代码。目前已达到 5 张； AB、BC、CD、DE 和 EF。 AB 是标准的，BC 是已排序的并删除了列，CD 和 DE 都是按字母顺序排序的，EF 是标准的。电子邮件开始时一切正常，AB 按预期输出。然后我收到 3 封 BC 电子邮件，跳过 CD 和 DE，然后我在 EF 上收到一条错误消息。我已在下面代码的注释中添加了该消息，位于调试器指向的行的正上方。

Sub PasteARtoEmail()

    Dim olApp As Object
    Dim olMail As Object
    Dim rng As Range
    Dim wdDoc As Object
    Dim oRange As Object
    Dim wb1 As Workbook
    Dim ws1 As Worksheet
    Dim lastrow As Integer
    Dim intAge As Integer
    Dim intTotal As Integer
    Dim strWB As String
    
    'grab the name of the current week's workbook
    strWB = InputBox("Enter the name of the current week's AR report, without the file extension.", "Current AR Report")
    Set wb1 = Workbooks(strWB & ".xlsx")
    
    'count how may reps have worksheets in the book
    For i = 1 To wb1.Worksheets.Count
    
        'dont put KT's AR in an email unless it's another country's book
        If wb1.Worksheets(i).Name = "KT" Then
            If ws1.Index > 5 Then
                i = i + 1
            End If
        End If
        
        'Now as long as it's not KT in domestics, we run it
        Set ws1 = wb1.Worksheets(i)
        
        'open the new email for this sales rep
        Set olApp = CreateObject("Outlook.Application")
        Set olMail = olApp.CreateItem(0)
        With olMail
                
                .display
                
                .Subject = "Weekly AR Report - " & strWB & " - "
                
                Set OlInsp = .getInspector
                Set wdDoc = OlInsp.WordEditor
                
                olFormatRichText = 3
                .BodyFormat = olFormatRichText
        End With
        
        'A2 will always say "Current" for the Reps who aren't sorted alphabetically.
        'If they just get the basic QB export, this will be what's run.
        'This the majority of Reps.
        If ws1.Cells(2, 1).Value Like "Current" Then
        
            'Grab the last real row with any info, QB likes to insert some extra at the end
            lastrow = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row
            
            'lastrow is the total of all agings, this grabs the >90 total row, the period where we start.
            intTotal = lastrow - 1
            
            'Stops when the row value of the total's gets below the
            '"current" mark, aka row 1
            Do While intTotal > 2
                
                'ensures that there is a blank between the total and age cells, if so then there's an invoice during the period
                'and that invoice needs to be noted in the email to the rep
                'My hope is that this loops for every aging section
                If Cells(intTotal - 1, 1).Value = "" Then
            
                    intAge = ws1.Cells(intTotal, 1).End(xlUp).Row
             
                    Set rng = ws1.Range(Cells(intAge, 1).Address, Cells(intTotal, 23).Address)
                    
                    rng.Copy
                    
                    'This is where I am probably missing something. The Outlook commands from excel VBA are new to me, and I'm
                    'probably missing something.
                    With olMail
                    
                        Set oRange = wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range
                        
                        'This line is where I get an error code:
                        '"Run-time error '4605'
                        '
                        'This method or property is not available here because the Clipboard is
                        'empty or not valid"
                        oRange.Paste
                        
                        oRange.InsertParagraphAfter
                    End With
                    
                    intTotal = intAge - 1
                
                'if there's not a blank, then there is no invoices in that period, skip to the next total line
                Else
                    intTotal = intTotal - 2
                End If
                
            Loop
                
        Else
        
            'If Current isn't in A2, then it's one of the alphabetically
            'sorted AR reports. BC is the outlier for formatting, so
            'we'll check for him first.
            'All we need to do is grab the whole sheet's contents and paste it in one big block in the email
            If ws1.Name = "BC" Then
            
                lastrow = ws1.Cells(ws1.Rows.Count, "J").End(xlUp).Row
             
                Set rng = ws1.Range("A1:K" & lastrow)
                
                rng.Copy
                
                With olMail
                
                    Set oRange = wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range
                    oRange.Paste
                    
                    oRange.InsertParagraphAfter
                End With
                            
            'And then we hit the few other Reps who get sorted Alphabetically instead of by aging
            'Again, just need to grab the one huge block and paste it.
            Else
                
                lastrow = ws1.Cells(ws1.Rows.Count, "V").End(xlUp).Row
             
                Set rng = ws1.Range("D1:W" & lastrow)
                
                With olMail
                
                    Set oRange = wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range
                    oRange.Paste
                    
                    oRange.InsertParagraphAfter
                End With
                
            End If
        End If
    
    'I don't know if this is necessary? is this part of what's throwing the error?
    Set olMail = Nothing
    Set olApp = Nothing
    Next i
    
End Sub

我承认我对 VBA 和编码非常陌生，所以这可能是因为不知道有助于简化此过程的方法或东西。我确实注意到，在本地视图选项卡中，“oRange”的值都表示“远程服务器计算机不存在或不可用，但我不知道为什么在构建 5 封电子邮件后会弹出它。

那么，为什么会出现该错误？这与我检查内容的方式有关吗？我可以尝试什么才能使其正常工作？