搜索工作簿并在不打开它的情况下提取数据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 文件在 A1 中的值为 Hello World!，在 A2:D2 范围内的值分别为 FirstHeader、SecondHeader、ThirdHeader 和 FourthHeader。第一个过程在消息框中返回Hello World!，第二个过程在消息框中返回FirstHeader。

将数据加载到Recordset 后，您可以遍历它并执行您的逻辑。

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