поиск рабочих книги и извлечение данных без вскрытия Excel VBA

Question

У меня есть некоторый код VBA для открытия файлов Excel на основе имени файла-дату (то есть «тест-09Sep2016.xlsm».

После того как файл открыт, он ищет через книгу и попытки найти то, что я ищу. После того, как она вернет результаты, она закроет книгу и проверит ее в папке, чтобы найти следующий файл и т. д.

Проблема в том, что размер файла массивный, и открытие файла занимает довольно много времени, мне интересно, есть ли способ сделать это, не открывая фактический файл.

Мой текущий код ниже:

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 

Любая помощь была бы принята с благодарностью!

Благодаря

Answer 1

можно извлекать данные из Excel без открытия файла с помощью adodb, но вы должны (насколько я знаю) знаете по крайней мере первый столбец/строку и последний столбец из набора данных в целевом файле. Вам не нужно знать последнюю строку.

Например, этот код вызывает две отдельные процедуры, тот, который возвращает значение из одной клетки, и один, который возвращает значение первой ячейки в определенном диапазоне, от закрытой книги под названием 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 

файл GetDataInClosedWB имеет значение Hello World! в A1 и значения FirstHeader, SecondHeader, ThirdHeader и FourthHeader в диапазоне A2: D2, соответственно. Первая процедура возвращает Hello World! в поле сообщения, а вторая возвращает FirstHeader в поле сообщения.

После того, как вы загрузили данные в Recordset, вы можете перебирать их и выполнять свою логику.

Примечание: если вы предпочитаете раннее связывание, вам необходимо включить ссылку на библиотеку объектов данных Microsoft ActiveX.