运行此宏（使用AutomationWhere）时，VBA几个小时不响应

Question

我正在使用SAP下载的一些下载报告。

我需要通过一列过滤此报告，然后将此过滤后的报告复制到我的另一个文件 工作共享驱动器。

有时，当我尝试在我的生产服务器上运行这个宏观波纹管时，Excel会冻结数小时（4小时或更长时间），然后我需要停止所有内容并重新开始。

在运行此宏之前，您知道我该怎么做才能“清洁” Excel？也许可以清除缓存或代码中的文章？

Sub PasteReportZFIInflowCheck()

' This macro will open the downloaded ZFI report from SAP, filter to only InflowCheck and copy to the final report at Sharedrive


    ' Disable Alerts, ScreenUpdating
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    

    ' Set Variables
    Try = 0
    Set ReportPath = Range("A1")
    Set Report = Range("B1")
    Set ResultPath = Range("A2")
    Set Result = Range("B2")
    Set PasteCell = Range("A3")
    Set SheetName = Range("C2")
    Dim wb As Workbook
    
    
' Main Task
MainTask:
    
    Do While Try < 3
    On Error GoTo ErrorHandler
    
    ' SAP Report Download (Filter and Copy)
    Workbooks.Open Filename:=ReportPath
    
    'Replace . to ,
    Columns("AH:BB").Select
    Selection.Replace What:=".", Replacement:=",", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
        
    'Filter
    Range("A1").Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$BC$999999").AutoFilter Field:=1, Criteria1:="1"
         
    'Check if we have any Data
    i = 1
    j = 1
    Do While Sheets("Sheet1").Cells(i, j) <> Empty
    i = i + 1
    Cells(i, j).Select
    Value = ActiveCell
        If Value = "1" Then
        CheckEmpty = 1
        End If
    Loop
    
    'Have data
    If CheckEmpty = 1 Then
    
    ' Copy all data
    Range("A1").Select
    Selection.Offset(1, 0).Select ' seta para baixo
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
        
    
    ' Open Result sheet
    Workbooks.Open Filename:=ResultPath
    ActiveWorkbook.Worksheets("Check 01 a 31_SAP").Activate
       
    
    'Look for last empty line
    Range(PasteCell).Select
    i = 2
    j = ActiveCell.Column
    Do While Sheets("Check 01 a 31_SAP").Cells(i, j) <> Empty
    i = i + 1
    Loop
    Cells(i, j).Select

    'Paste the report
    ActiveSheet.Paste
    
    End If
    

    'Save and close Result workbook
    ActiveWorkbook.Close SaveChanges:=True
    

    'Close others workbooks
    ActiveWorkbook.Worksheets("Sheet1").Activate
    ActiveWorkbook.Close SaveChanges:=False
    
    'Cancel Loop
    Try = 3
    Loop
    
    ' Clear Copied data
    Application.CutCopyMode = False
    Application.CutCopyMode = True
        

    ' Enable ScreenUpdating
     Application.ScreenUpdating = True
    
    
    Application.Quit
    
    Exit Sub
    
    
ErrorHandler:
    On Error GoTo -1
    Try = Try + 1
    
    ' close all workbooks
    ActiveWorkbook.Worksheets("Check 01 a 31_SAP").Activate
    ActiveWorkbook.Close SaveChanges:=False
    ActiveWorkbook.Worksheets("Sheet1").Activate
    ActiveWorkbook.Close SaveChanges:=False
    
    GoTo MainTask
    
End Sub