用于循环指定文件夹中的所有excel文件以及从特定单元格中提取数据的代码

时间:2011-05-01 21:28:32

标签: excel vba loops vbscript

我需要从大约50个左右的Excel工作簿中提取数据。我需要从特定单元格,特定工作表中获取数据并编译成一个数据集(最好是另一个excel工作簿)。

我正在寻找一些VBA,以便我可以将结果编译到我用来运行代码的工作簿中。

因此,我需要从工作表(“DataSource”)中提取数据的xls或xlsx文件之一,我需要评估单元格(D4),如果它不为null,则从单元格中提取数据(F4) ,并将新行放入已编译的数据集中。循环遍历上面提到的该文件夹中的所有Excel文件。

如果可能的话,我希望第一列中的第一个数据字段是在结果数据集中从中提取数据的文件的名称。

有人可以帮我吗?我正在寻找VBA,因为我对此更熟悉,但也对VBScript感兴趣(因为我正在尝试进入并了解其中的差异)。

5 个答案:

答案 0 :(得分:11)

首先从this google query开始,然后点击出现的第一个链接,转到an article,显示如何遍历文件夹中的一组Excel文件。

Sub RunCodeOnAllXLSFiles()
Dim lCount As Long
Dim wbResults As Workbook
Dim wbCodeBook As Workbook


Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False

On Error Resume Next
    Set wbCodeBook = ThisWorkbook
        With Application.FileSearch
            .NewSearch
            'Change path to suit
            .LookIn = "C:\MyDocuments\TestResults"
            .FileType = msoFileTypeExcelWorkbooks
            'Optional filter with wildcard
            '.Filename = "Book*.xls"
                If .Execute > 0 Then 'Workbooks in folder
                    For lCount = 1 To .FoundFiles.Count 'Loop through all
                        'Open Workbook x and Set a Workbook variable to it
                        Set wbResults = Workbooks.Open(Filename:=.FoundFiles(lCount), UpdateLinks:=0)

                        'DO YOUR CODE HERE

                        wbResults.Close SaveChanges:=False
                    Next lCount
                End If
        End With
On Error GoTo 0
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.EnableEvents = True
End Sub

要获取工作簿的名称,您需要调整“在此处编写代码”中的代码以包含wbResults.Name。如果它是您想要的文件名,请使用wbResults.FullName,它返回工作簿的名称,包括其在磁盘上的路径作为字符串。

搜索VBScript variation on the same thing会产生许多有用的结果,包括此脚本:

strPath = "C:\PATH_TO_YOUR_FOLDER"

Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.DisplayAlerts = False

Set objFso = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFso.GetFolder (strPath)

For Each objFile In objFolder.Files

If objFso.GetExtensionName (objFile.Path) = "xls" Then
   Set objWorkbook = objExcel.Workbooks.Open(objFile.Path)
   ' Include your code to work with the Excel object here
   objWorkbook.Close True 'Save changes
End If

Next

objExcel.Quit

答案 1 :(得分:4)

如果您有这种倾向,我会在VBScript甚至VB.NET或Powershell中这样做。

使用VB.NET,您可以通过OLEDB提供程序访问Excel电子表格,就像它们是数据库一样。选择一系列值的代码可能如下所示:

 Try
        Dim MyConnection As System.Data.OleDb.OleDbConnection
        Dim DtSet As System.Data.DataSet
        Dim MyCommand As System.Data.OleDb.OleDbDataAdapter
        MyConnection = New System.Data.OleDb.OleDbConnection _
        ("provider=Microsoft.Jet.OLEDB.4.0;"  _
        " Data Source='testfile.xls'; " _
         "Extended Properties=Excel 8.0;")
        MyCommand = New System.Data.OleDb.OleDbDataAdapter _
            ("select * from [Sheet1$]", MyConnection)
        MyCommand.TableMappings.Add("Table", "TestTable")
        DtSet = New System.Data.DataSet
        MyCommand.Fill(DtSet)
        MyConnection.Close()
    Catch ex As Exception
        MsgBox(ex.ToString)
    End Try

获得数据后,您可以详细说明,然后使用相同的API将结果插入到另一个Excel电子表格中。

通过调用System.IO.Directory.GetFiles(),在.NET中轻松获取文件列表;只需指定“* .xls”通配符。获得列表后,只需使用for循环迭代它,依次打开每个文件,然后对那个文件进行查询,依此类推。

如果您使用VBScript,那么获取Excel文件列表的首选方法是使用Scripting.FileSystemObject,特别是GetFolder method。它的工作方式基本相同,但语法略有不同。


如果它是VBScript或VB.NET,它可能会在Excel之外运行。您可以通过双击或批处理文件或类似文件来运行它。使用VB.NET的优点是你可以建立一个图形表格进行交互 - 它可以显示一个进度条,跟踪你经历了多少文件,状态更新,这种事情。

答案 2 :(得分:1)

每当您连续访问那么多Excel文件时,通常可以使用ADODB而不是Excel的自动化对象获得更好的性能。

答案 3 :(得分:0)

我同意使用访问Excel对象并不是最快的,如果您尝试从中检索数据的工作簿和工作表都是一致的(即具有相同的列名等等...或者在至少你要查​​找的列名称)使用ODBC会更好。这确实有一些问题,如果你无法绕过它们或者需要根据内容实际做一些更复杂的事情,那么可能无法绕过它。如果是这样,那么我建议创建一个Excel对象,然后根据需要打开和关闭文件,以提高效率。

答案 4 :(得分:0)

可以使用以下代码

完成
Sub LoopThroughFiles()

Dim StrFile As String
StrFile = Dir("V:\XX\XXX\*.xlsx")
 Do While Len(StrFile) > 0
    Debug.Print StrFile
       Set wbResults = Workbooks.Open("V:\XX\XXX\" & StrFile)   

                    'DO YOUR CODE HERE


       wbResults.Close SaveChanges:=True
    StrFile = Dir
 Loop
End Sub