使用VBA将多个文件中的表提取到Excel
我没有使用VBA的经验,因为我通常使用Matlab或Python,但它似乎是我拥有的项目中最有用的工具。基本上,从大量Word文件中,我必须提取一个表并将其放入单个Excel文件中。 从YT教程中,我已经有了以下基本代码:使用VBA将多个文件中的表提取到Excel,vba,excel,ms-word,Vba,Excel,Ms Word,我没有使用VBA的经验,因为我通常使用Matlab或Python,但它似乎是我拥有的项目中最有用的工具。基本上,从大量Word文件中,我必须提取一个表并将其放入单个Excel文件中。 从YT教程中,我已经有了以下基本代码: Sub CopyTable() Application.Templates.LoadBuildingBlocks Dim xlApp As Excel.Application Dim xlwb As Excel.Workbook Dim doc As Document Di
Sub CopyTable()
Application.Templates.LoadBuildingBlocks
Dim xlApp As Excel.Application
Dim xlwb As Excel.Workbook
Dim doc As Document
Dim tbl As Table
Dim LastRow As Long, LastColumn As Integer
Dim tblRange As Range
Set doc = ThisDocument
Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
Set xlwb = xlApp.Workbooks.Add
Set tbl = doc.Tables(3)
With tbl
LastRow = .Rows.Count
LastColumn = .Columns.Count
Set tblRange = .Cell(1, 1).Range
tblRange.End = .Cell(LastRow, LastColumn).Range.End
tblRange.Copy
xlwb.Worksheets(1).Paste
End With
Set xlwb = Nothing
Set xlApp = Nothing
Set tblRange = Nothing
Set tbl = Nothing
Set doc = Nothing
End Sub
但是,我现在要做的是将此代码应用于包含多个doc(x)文件的特定文件夹。我想在同一个Excel文件中的单独表格中包含每个单独Word文件的表格。如何制作xlwb.工作表(1).粘贴动态?
另外,是否可以先将Word文件的文件名粘贴到Excel工作表的第一个单元格中,然后复制旁边的表格
如果您能提供任何有关这些版本的指导,我们将不胜感激
增加:
根据以下建议,我已开始在Excel中编写脚本:
Sub ImportWordTable()
Dim wdDoc As Object
Dim wdFileName As Variant
Dim TableNo As Integer
Dim iRow As Long
Dim iCol As Integer
filelist = Application.GetOpenFilename("Word files (*.doc),*.doc", , _
"Browse for file containing table to be imported", MultiSelect:=True)
If IsArray(filelist) Then
For i = 1 To Len(filelist)
wdFileName = filelist(i)
Set wdDoc = GetObject(wdFileName)
With wdDoc
TableNo = wdDoc.Tables.Count
If TableNo = 0 Then
MsgBox "This document contains no tables", _
vbExclamation, "Import Word Table"
ElseIf TableNo > 1 Then
TableNo = InputBox("This Word document contains " & TableNo & " tables." & vbCrLf & _
"Enter table number of table to import", "Import Word Table", "1")
End If
With .Tables(TableNo)
For iRow = 1 To .Rows.Count
For iCol = 1 To .Columns.Count
'ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
'ActiveWorkbook.Sheets(Worksheets.Count).Name = Dir(wdFileName)
'Worksheets(Dir(wdFileName)).Activate
ActiveWorkbook.Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = Dir(wdFileName)
Worksheets(Dir(wdFileName)).Activate
ActiveSheet.Cells(iRow, iCol) = WorksheetFunction.Clean(.Cell(iRow, iCol).Range.Text)
Next iCol
Next iRow
End With
End With
wdDoc.Quit savechanges = False
Next i
Else
wdFileName = filelist
Set wdDoc = GetObject(wdFileName)
With wdDoc
TableNo = wdDoc.Tables.Count
If TableNo = 0 Then
MsgBox "This document contains no tables", _
vbExclamation, "Import Word Table"
ElseIf TableNo > 1 Then
TableNo = InputBox("This Word document contains " & TableNo & " tables." & vbCrLf & _
"Enter table number of table to import", "Import Word Table", "1")
End If
With .Tables(TableNo)
For iRow = 1 To .Rows.Count
For iCol = 1 To .Columns.Count
Cells(iRow, iCol) = WorksheetFunction.Clean(.Cell(iRow, iCol).Range.Text)
Next iCol
Next iRow
End With
End With
End If
Set wdDoc = Nothing
End Sub
我现在可以选择多个文件,还添加了一个函数,该函数使用文件名命名工作表。但是,从第一个文件复制信息后,代码无法正常运行。似乎for循环没有正确更新,因为我收到一条消息:“此工作表名称已存在”。也许我在循环和索引方面遗漏了一些VBA逻辑 我同意其他答案,这最好在excel vba中完成。
我建议做点类似的事情
filelist=application.getopenfilename,multiselect设置为true,以获取文件列表
然后使用for i=0 to len(filelist)结构循环列表,如果从1个工作表开始,则每个工作表将被命名为工作表i+1,您可以使用它来引用它并添加内容/重命名它et.c,您可以从列表位置提取文件名。您可以使用Power Query从文件夹中的每个Word文档提取表格数据。这里有一个很好的例子:根据PEH和我之前的评论,这里有一个方法
在模块中复制以下自定义项:
Sub LookForWordDocs()
Dim sFoldPath As String: sFoldPath = "c:\temp\" ' Change the path. Ensure that your have "\" at the end of your path
Dim oFSO As New FileSystemObject ' Requires "Microsoft Scripting Runtime" reference
Dim oFile As file
' Loop to go through all files in specified folder
For Each oFile In oFSO.GetFolder(sFoldPath).Files
' Check if file is a word document. (Also added a check to ensure that we don't pick up a temp Word file)
If (InStr(1, LCase(oFSO.GetExtensionName(oFile.Path)), "doc", vbTextCompare) > 0) And _
(InStr(1, oFile.Name, "~$") = 0) Then
' Call the UDF to copy from word document
CopyTableFromWordDoc oFile
End If
Next
End Sub
上面的自定义项检查指定文件夹中的所有文件,并将Word
文档传递到下面的自定义项:
Sub CopyTableFromWordDoc(ByVal oFile As file)
Dim oWdApp As New Word.Application ' Requires "Microsoft Word .. Object Library" reference
Dim oWdDoc As Word.Document
Dim oWdTable As Word.Table
Dim oWS As Worksheet
Dim lLastRow$, lLastColumn$
' Code to copy table from word document to this workbook in a new worksheet
With ThisWorkbook
' Add the worksheet and change the name to what file name is
Set oWS = .Worksheets.Add
oWS.Name = oFile.Name
' Open Word document
Set oWdDoc = oWdApp.Documents.Open(oFile.Path)
' Set table to table 3 in the document
Set oWdTable = oWdDoc.Tables(1)
' Copy the table to new worksheet
oWdTable.Range.Copy
oWS.Range("A1").PasteSpecial xlPasteValues, xlPasteSpecialOperationNone
' Close the Word document
oWdDoc.Close False
' Close word app
oWdApp.Quit
End With
End Sub
CopyTableFromWordDoc UDF未经测试,因为我没有word文档对其进行测试
如果然后运行LookForWordDocs,它将遍历指定文件夹中的所有文件,并将它们从WordDocUDF传递到CopyTable(不包括任何非Word
文档和任何临时Word
文档)CopyTableFromWordDoc在当前工作簿中添加新工作表,并将工作表重命名为与文件名相同的名称。然后,它将表格(3)从word文档复制到此新页
提示:在将工作表添加到工作簿之前,可以添加代码以删除任何现有工作表;这将防止您尝试使用与现有工作表相同的名称命名工作表我认为您需要反过来命名。当此代码从Word导出到Excel(代码在Word中运行)时,您需要编写代码从Word导入到Excel中。因此,您需要在Excel VBA中:① 循环通过文件夹循环并打开docx文件。② 在该循环中,为每个文件添加一个工作表,然后复制/粘贴该表。首先,我建议您在excel文件中执行此操作,因为您希望将多个Word文档中的所有数据保存到单个excel文件中。我很难用一个更简单的术语来解释这一点,但是,我会使用不止一个UDF来解释这一点。主自定义项,用于遍历文件夹并决定需要打开哪个文件。此UDF将调用第二个UDF(与您的UDF非常相似),该UDF将复制和复制新工作表中的表,并将其复制到您的工作表所在的同一文件中code@Pᴇʜ伟大的头脑和所有这些:)谢谢!我试图运行代码,但在“oWdRange.End=oWdTable.Cell(lLastRow,lLastColumn).Range.End”行中出现编译错误“Argument not optional”。我用一个表创建了一个word文档,这次测试了代码。将编辑过的CopyTableFromWordDoc UDF复制到您的模块(删除旧版本)并尝试一下(别忘了更改表号)