搜索工作簿并提取数据而不打开Excel VBA [英] Search workbook and extract data without opening it excel vba

问题描述

我有一些vba代码可以根据文件名日期(即"test-09Sep2016.xlsm")打开excel文件.

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.

我当前的代码如下:

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

任何帮助将不胜感激！

谢谢

推荐答案

可以使用 adodb ，但是您(据我所知)必须至少了解目标文件中的数据集.您不需要知道最后一行.

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.

例如，此代码从名为 GetDataInClosedWB 的封闭工作簿中调用两个单独的过程，一个过程从单个单元格返回值，一个过程返回定义范围内第一个单元格的值.:

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

GetDataInClosedWB 文件在A1中具有值 Hello World！，值分别为 FirstHeader ， SecondHeader ， ThirdHeader 和 FourthHeader 分别在A2:D2范围内.第一个过程在消息框中返回 Hello World！，第二个过程在消息框中返回 FirstHeader .

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.

一旦将数据加载到 Recordset 中，就可以遍历数据并执行逻辑.

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

注意:如果您希望早期绑定，则需要启用对Microsoft ActiveX数据对象库的引用.

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

这篇关于搜索工作簿并提取数据而不打开Excel VBA的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！