Question

本周一开始，当我完成我的代码时，代码的目的是从该文件夹中的所有电子表格中的特定文件夹中的特定工作表中提取数据。

但就在昨晚他每次按下运行按钮时都开始崩溃excel电子表格。

知道为什么吗？

Option Explicit

Sub ImportSheet()
    Dim i As Integer
    Dim SourceFolder As String
    Dim FileList As Variant
    Dim GrabSheet As String
    Dim FileType As String
    Dim ActWorkBk As String
    Dim ImpWorkBk As String
    Dim NoImport As Boolean
Application.EnableEvents = False
    SourceFolder = "C:\Users\Jarryd.Ward\Desktop\Test\"
    FileType = "*.xlsx"
    GrabSheet = "Summary"
    FileList = ListFiles(SourceFolder & "/" & FileType)

    Application.ScreenUpdating = False
    ActWorkBk = ActiveWorkbook.Name
    NoImport = False

    For i = 1 To UBound(FileList)
        Workbooks.Open (SourceFolder & "\" & FileList(i))
        ImpWorkBk = ActiveWorkbook.Name
        On Error Resume Next
            ActiveWorkbook.Sheets(GrabSheet).Select
            If Err > 0 Then
                NoImport = True
                GoTo nxt
            End If
            Err.Clear
        On Error GoTo 0

        ActiveWorkbook.Sheets(GrabSheet).Copy After:=Workbooks(ActWorkBk).Sheets(Workbooks(ActWorkBk).Sheets.Count)
           ActiveSheet.Name = ImpWorkBk

        On Error Resume Next
            ActiveSheet.Name = FileList(i) & " - " & GrabSheet
            Err.Clear
        On Error GoTo 0
nxt:
        Workbooks(ImpWorkBk).Activate
        Application.DisplayAlerts = False
        ActiveWorkbook.Saved = True
        ActiveWorkbook.Close SaveChanges:=False
        Application.DisplayAlerts = True
        Workbooks(ActWorkBk).Activate
    Next i
    Application.ScreenUpdating = True
End Sub

Answer 1

尝试以这种方式打开和关闭文件以查看它是否有帮助。它应该最小化激活这个或那个的调用。通过变量而不是activesheet关闭将确保您的代码不会意外地关闭主工作簿。

Sub testOpen()
Dim manyWBs As Workbook
Dim myWB As Workbook


Set myWB = ThisWorkbook


For Each file In folder
    Set manyWBs = Workbooks.Open("C:\temp\filename")


'   do events.......
manyWBs.Worksheets("Sheet1").Range("A1:B13").Copy _
       Destination:=myWB.Worksheets("Sheet1").Range("A1:b13")




    manyWBs.Close
    Set manyWBs = Nothing
Next file




Set myWB = Nothing
End Sub

VBA代码不稳定

1 个答案: