Search workbook and extract data without opening i

Question

I have some vba code to open excel files based on the filename-date (i.e. "test-09Sep2016.xlsm".

After the file is opened, it searches through the workbook and attempts to find what I'm looking for. Once it returns the results, it will close the workbook and loop through the folder to find the next file and so forth....

The issue is that the file size is massive and opening the file takes quite a while, i'm wondering if there is a way to do so without opening the actual file.

My current code is below:

Sub firstCoord()

Dim fpath As String, fname As String
Dim dateCount As Integer, strDate As Date
Dim i As Integer, j As Integer, k As Integer, lastRow As Integer, lastRow2 As Integer
Dim ws As Worksheet, allws As Worksheet
Dim seg As String
Dim strNum As String
Dim strRow As Integer


lastRow = Sheet1.Range("A" & Sheet1.Rows.Count).End(xlUp).Row
seg = Mid(ThisWorkbook.Name, 34, 1)

With Application.WorksheetFunction

For i = 2 To lastRow

    fpath = "_______\"
    strDate = Sheet1.Range("B" & i)
    strNum = seg & Format(Mid(Sheet1.Range("A" & i), 4, 3), "000") & "000"

    dateCount = 0

    Do While Len(Dir(fpath & "_____-" & Format(strDate - dateCount, "ddmmmyyyy") & ".xlsx")) = 0 And dateCount < 35
    dateCount = dateCount + 1
    Loop

    fname = "____-" & Format(strDate - dateCount, "ddmmmyyyy") & ".xlsx"

    Workbooks.Open (fpath & fname)

    For Each ws In Workbooks(fname).Worksheets
        If ws.Name Like "*all*" Then
            Set allws = Workbooks(fname).Worksheets(ws.Name)
            ws.Activate
        End If
    Next ws

    lastRow2 = ActiveSheet.Range("A" & ActiveSheet.Rows.Count).End(xlUp).Row


    ThisWorkbook.Activate



    k = 1
    Do While (.CountIf(Sheet1.Range("C" & i & ":" & "E" & i), "") <> 0 Or Sheet1.Range("F" & i) = "") And k <= lastRow2


        If Left(allws.Range("A" & k), 7) = strNum Then
            Sheet1.Range("C" & i) = allws.Range("D" & k)
            Sheet1.Range("D" & i) = allws.Range("C" & k)
            Sheet1.Range("E" & i) = allws.Range("E" & k)
        ElseIf k = lastRow2 And Sheet1.Range("C" & i) = "" Then
            Sheet1.Range("F" & i) = "Not Found"

        End If

        k = k + 1

    Loop



    Workbooks(fname).Close


Next i


End With

End Sub

Any help would be greatly appreciated!!

Thanks

Answer 1

It is possible to retrieve data from Excel without opening the file using adodb, but you must (as far as I know) know at least the first column/row and last column of the dataset in the target file. You do not need to know the last row.

For example, this code calls two separate procedures, one that returns the value from a single cell and one that returns the value of the first cell in the defined range, from a closed workbook named GetDataInClosedWB:

Sub Main()
    Call GetDataFromSingleCell("A1")
    Call GetDataFromRangeBlock("A2", "D")
End Sub
Sub GetDataFromSingleCell(cell As String)

    Dim CN As Object ' ADODB.Connection
    Dim RS As Object ' ADODB.Recordset

    Set CN = CreateObject("ADODB.Connection")
    Set RS = CreateObject("ADODB.Recordset")

        CN.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                "Data Source=" & CStr("C:\Users\USERNAME\Desktop\GetDataInA1.xlsx") & _
                ";" & "Extended Properties=""Excel 12.0;HDR=No;"";"
    RS.Open "SELECT * FROM [Sheet1$" & cell & ":" & cell & "];", CN, 3, 1  'adOpenStatic, adLockReadOnly


    MsgBox (RS.Fields(0).Value)
End Sub
Sub GetDataFromRangeBlock(firstCell As String, lastCol As String)
    'firstCell is the upper leftmost cell in the target range
    'lastCol is the column reference (e.g. A,B,C,D...) of the last column in the 
    'target dataset

    Dim CN As Object ' ADODB.Connection
    Dim RS As Object ' ADODB.Recordset

    Set CN = CreateObject("ADODB.Connection")
    Set RS = CreateObject("ADODB.Recordset")

    CN.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
             "Data Source=" & CStr("C:\Users\USERNAME\Desktop\GetDataInA1.xlsx") & _
             ";" & "Extended Properties=""Excel 12.0;HDR=No;"";"
    RS.Open "SELECT * FROM [Sheet1$" & firstCell & ":" & lastCol & "];", CN, 3, 1  'adOpenStatic, adLockReadOnly


    MsgBox (RS.Fields(0).Value)
End Sub

The GetDataInClosedWB file has the value Hello World! in A1 and values FirstHeader, SecondHeader, ThirdHeader, and FourthHeader in range A2:D2, respectively. The first procedure returns Hello World! in a message box, and the second return FirstHeader in a message box.

Once you've loaded the data into a Recordset you can iterate through it and perform your logic.

Note: if you prefer early binding, you'll need to enable a reference to a Microsoft ActiveX Data Objects Library.