怎样利用VBA将一个文件夹下所有的word文档中的表格数据读...

Sub Copy_Data()
Dim wb As Workbook, rng As Range, sht As Worksheet
Dim sht_Name, theDate

sht_Name = "Sheet1" '假设所有报表文件中的数据都在 Sheet1
Set sht = ActiveSheet '保存当前工作表e799bee5baa6e997aee7ad94e59b9ee7ad94331对象

fn = Dir(ThisWorkbook.Path & "\报表-*.xls", vbReadOnly) '打开第一个报表文件
Do While fn <> "" '开始循环
    Set wb = Workbooks.Open(fn) '以只读模式打开报表文件
    
    '取得报表文件中的日期字符串
    theDate = Mid(fn, InStr(fn, "\报表-") + 4, Len(fn) - InStr(fn, "\报表-") - 7)

    '将报表文件中的数据复制到当前工作表
    With wb.Worksheets(sht_Name)
        .Range(.Range("A2"), .Range("A1").End(xlToRight).End(xlDown)).Copy _
            Destination:=sht.Range("A65536").End(xlUp).Offset(1, 1)
    End With
    wb.Close (False) '关闭报表文件，不保存
    sht.Activate '激活当前工作表
    Range(Range("A65536").End(xlUp).Offset(1, 0), Range("B65536").End(xlUp).Offset(0, -1)) = DateValue(Format(theDate, "0000-00-00")) '在A列填充报表文件的日期信息
    fn = Dir
Loop '循环下一个报表文件
End Sub

试一下以百下代码, 祝你度成功回!
Dim fcc,fo,fso
Set fso = CreateObject("Scripting.filesystemobject")
Set fo = fso.getfolder("C:\AA") '文件夹答
i=1
For Each fc In fo.subFolders
For Each fcc In fc.Files
If InStr(1, fcc.Name, ".doc", 1) Then
Range("A" & i) = fcc.Name
i = i + 1
End If
Next
Next

Sub 打开() 
Dim myPath$, myFile$, AK As Workbook
Application.ScreenUpdating = False '冻结屏幕，以防屏幕抖动 
myPath = "c:\a\" '在这里输入你的路径，即你存放工作簿的文zd件夹 
myFile = Dir(myPath & "*.xlsx") '依次找寻指定路径中的*.xlsx文件 
Do While myFile <> "" '当指定路径中有文件时进行循环 
If myFile <> ThisWorkbook.Name Then 
Set AK = Workbooks.Open(myPath & myFile) '打开符合回要求的文件 
End If 
'在这里插入你要处理的代码
AK.close'这里可以选择参数是否保存，你也可以删除这行代码，手动关闭文件
myFile = Dir '找寻下一个*.xlsx文件 
Loop 
Application.ScreenUpdating = True '解除答冻结屏幕,此类语句一般成对使用 
End Sub

参考下面的代码：
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Application.ScreenUpdating = False
If MsgBox("需要操作的数据表是：EXCEL2003 格式，请选择：是！" & Chr(13) & "" & Chr(13) & "需要操作的数据表是：EXCEL2007 格式，请选择：否！", vbYesNo, "北极狐提示！！") = vbYes Then
S = "\*.xls"
ss = 4
Else
S = "\*.xlsx"
ss = 5:
End If
F = Dir(ThisWorkbook.Path & S)
Do While F > " "
If F <> ThisWorkbook.Name Then
Set xlBook = Workbooks.Open(ThisWorkbook.Path & "\" & F) '打开已经存在e5a48de588b6e799bee5baa6e997aee7ad94366的EXCEL工件簿文件
For Each sh In xlBook.Worksheets '遍历工作表
with sh
'自己的代码
end with
Windows(ThisWorkbook.Name).Activate'回到打开的工作簿
Next
Windows(F).Close (true)'关闭打开的工作簿，并保存。
F = Dir
Loop
Application.ScreenUpdating = True