首页 > 解决方案 > 运行时错误 91 将数据复制到工作簿并通过电子邮件发送

问题描述

我正在尝试编写发送电子邮件附件的代码:3 张,前 2 张带有来自自动过滤器的表格(表格 Ash,Bsh),最后带有图表图片(基于来自表格 Chsh 的自动过滤器)。代码应遍历第一个表并发送带有仅与该人相关的数据的附件的电子邮件。当我用前 2 张纸打结时它有效,它也适用于第 1 张和第 3 张纸。但总的来说,我得到错误'运行时错误91'对象变量或未设置块变量,如正在删除临时excel文件的Cws.Delete 。你能帮我找出代码的哪一部分是错误的吗?

Sub Send_Row_Or_Rows_Attachment()


    Dim OutApp As Object
    Dim OutMail As Object
    Dim rng As Range
    Dim rng2 As Range
    Dim Ash As Worksheet
    Dim Bsh As Worksheet
    Dim Chsh As Worksheet
    Dim ch As Worksheet
    Dim Cws As Worksheet
    Dim Rcount As Long
    Dim Rnum As Long
    Dim FilterRange As Range
    Dim FilterRange2 As Range
    Dim FilterRange3 As Range
    Dim FieldNum As Integer
    Dim mailAddress As String
    Dim ccAddress As String
    Dim NewWB As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim FileExtStr As String
    Dim FileFormatNum As Long
    Dim xChart As ChartObject
  
   
    On Error GoTo cleanup
    Set OutApp = CreateObject("Outlook.Application")

    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With
    
    Set Ash = Sheets("Final Status test")
    Set Chsh = Sheets("Chart_raw")
    Set Bsh = Sheets("Leads_row")
    Set ch = Sheets("Chart2")
    'Set filter range and filter column (column with names)
    Set FilterRange = Ash.Range("A1:I" & Ash.Rows.count)
    Set FilterRange2 = Bsh.Range("A1:O" & Bsh.Rows.count)
    Set FilterRange3 = Chsh.Range("A1:F" & Chsh.Rows.count)
    FieldNum = 1    'Filter column = A because the filter range start in column A

    'Add a worksheet for the unique list and copy the unique list in A1
    Set Cws = Worksheets.Add
    FilterRange.Columns(FieldNum).AdvancedFilter _
            Action:=xlFilterCopy, _
            CopyToRange:=Cws.Range("A1"), _
            CriteriaRange:="", Unique:=True

    'Count of the unique values + the header cell
    Rcount = Application.WorksheetFunction.CountA(Cws.Columns(1))
    'If there are unique values start the loop
    If Rcount >= 2 Then
        For Rnum = 2 To Rcount
        
                    'Look for the mail address in the MailInfo worksheet


                'Filter the FilterRange on the FieldNum column
                FilterRange.AutoFilter Field:=FieldNum, _
                                       Criteria1:=Cws.Cells(Rnum, 1).Value
                
                'Copy the visible data in a new workbook
                With Ash.AutoFilter.Range
                    On Error Resume Next
                    Set rng = .SpecialCells(xlCellTypeVisible)
                    On Error GoTo 0
                End With

                'Set NewWB = Workbooks.Add(xlWBATWorksheet)
                Set NewWB = Workbooks.Add
                
                
                rng.Copy
                With NewWB.Sheets(1)
                    .Cells(1).PasteSpecial Paste:=8
                    .Cells(1).PasteSpecial Paste:=xlPasteValues
                    .Cells(1).PasteSpecial Paste:=xlPasteFormats
                    '.Cells(1).Select
                    Application.CutCopyMode = False
                End With
                Sheets(1).Name = "Status"
                '---------------------------------------
                FilterRange2.AutoFilter Field:=FieldNum, _
                                       Criteria1:=Cws.Cells(Rnum, 1).Value
                                     
                With Bsh.AutoFilter.Range
                    On Error Resume Next
                    Set rng2 = .SpecialCells(xlCellTypeVisible)
                    On Error GoTo 0
                End With
                rng2.Copy
                With NewWB.Sheets(2)
                    .Cells(1).PasteSpecial Paste:=8
                    .Cells(1).PasteSpecial Paste:=xlPasteValues
                    .Cells(1).PasteSpecial Paste:=xlPasteFormats
                    '.Cells(1).Select
                    Application.CutCopyMode = False
                End With
                Sheets(2).Name = "details"
                '--------------------------------
                FilterRange3.AutoFilter Field:=FieldNum, _
                                       Criteria1:=Cws.Cells(Rnum, 1).Value
                                     
                With Chsh.AutoFilter.Range
                    On Error Resume Next
                    Set xChart = ch.ChartObjects("Chart 1")
                    
                    On Error GoTo 0
                End With
           
                xChart.CopyPicture
        
                With NewWB.Sheets(3)
                    .Range("B1").PasteSpecial
                    
                End With
                Sheets(3).Name = "Chart"
                '--------------------------------
                  'Create a file name(here body of e-mail) 
                 With NewWB
                    .SaveAs TempFilePath & TempFileName _
                          & FileExtStr, FileFormat:=FileFormatNum
                    On Error Resume Next
                    With OutMail
                        .Display  
                       
                    End With
                    On Error GoTo 0
                    .Close savechanges:=False
                End With

                Set OutMail = Nothing
                Kill TempFilePath & TempFileName & FileExtStr
            End If

            'Close AutoFilter
            Ash.AutoFilterMode = False
            Bsh.AutoFilterMode = False
            Chsh.AutoFilterMode = False
        Next Rnum
    End If

cleanup:
    Set OutApp = Nothing
    Application.DisplayAlerts = False
    Cws.Delete  'Here appears error
    
    Application.DisplayAlerts = True

    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
End Sub

标签: excelvbaruntime-error

解决方案


推荐阅读