Search code examples
performancevbaexcelexcel-2007

How to optimize opening and closing excel workbooks to extract data to run faster


I currently know of two methods to open and close excel workbooks to extract data from them to summarize in a single workbook.

The first method is as follows:

Dim wbDataSheet As Workbook
For FNum = LBound(MyFiles) To UBound(MyFiles)
    Set wbDataSheet = Workbooks.Open(MyPath & MyFiles(FNum), 0, True)

     'Capture data

    wbDataSheet.Close (False)
Next FNum

The second is this:

Dim XL As New Excel.Application
For FNum = LBound(MyFiles) To UBound(MyFiles)
    With XL
        .Workbooks.Open FileName:=MyPath & MyFiles(FNum), ReadOnly:=True
        .Visible = False
    End With

    'Capture Data

    XL.ActiveWorkbook.Close False
Next FNum

My dilemma is this:

Method 1 is faster (about .35 seconds/file for 1052 files) but it explodes my task bar as it opens new workbooks (making it near impossible to select a different excel workbook) and for some reason my code can be easily broken by pressing shift more than once or holding it at all, forcing me to start the code over.

Method 2 is noticeably slower (about .56 seconds/file for 1052 files) but since the excel application is hidden my taskbar remains usable and pressing shift doesn't break the code.

What I want to know is, is there a way to run method 1 without ruining my taskbar or having shift stop the code? Alternatively, is there a way to speed up method two to speeds near method 1?

*Note: I am already using the code below to optimize my speed and limiting vba/workbook interaction. Besides the methods to access the workbooks, the rest of the code in each scenario is identical.

With Application
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
    .EnableEvents = False
    .DisplayAlerts = False
End With

Solution

  • Example code for calling the GetValue function which uses ExecuteExcel4Macro:

    Sub test()
    Dim p As String, f As String, s as String, a as String
     
       p = "C:\Users\User\Documents\"
       f = "Example.xlsx"
       s = "Sheet1"  'This is the name of the Sheet in your file
       a = "D56"     'Range of the value you want I'm not sure if you can pull more than cell's value or not
    
       ThisWorkbook.Worksheets("Sheet2").Range("F21") = GetValue(p, f, s, a)  'Transfer the value
    End Sub
    

    GetValue function:

    Function GetValue(Path, file, sheet, ref)
    '   Retrieves a value from a closed workbook
        Dim arg As String
    '   Make sure the file exists
        If Dir(Path & file) = "" Then
            GetValue = "File Not Found"
            Exit Function
        End If
    '   Create the argument
        arg = "'" & Path & "[" & file & "]" & sheet & "'!" & _
          Range(ref).Range("A1").Address(, , xlR1C1)
    '   Execute an XLM macro
        GetValue = ExecuteExcel4Macro(arg)
    End Function