vba - 搜索工作簿并在不打开它的情况下提取数据excel vba

Question

我有一些 vba 代码可以根据文件名日期打开 excel 文件(即“test-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

可以使用 adodb 从 Excel 中检索数据而无需打开文件。 ，但您必须(据我所知)至少知道目标文件中数据集的第一列/行和最后一列。您不需要知道最后一行。

例如，此代码调用两个单独的过程，一个从单个单元格返回值，另一个从名为 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您可以遍历它并执行您的逻辑。

注意:如果您更喜欢早期绑定(bind)，则需要启用对 Microsoft ActiveX 数据对象库的引用。