|
论坛里看到大佬帖子里的关于数据提取的代码,请各位大佬帮忙改成只提取选定的WORD文件内所有数据,在提取的数据中有逗号或者空格的数据都进行数据拆分单元格,先拜谢各位大佬了!!
Sub 原表格原位置提取到一张表()
'更多下载www.15161218108.ys168.com
Dim tim2 As Date: tim1 = Timer
Cells.ClearContents
Cells.ClearContents
Dim NEWD As Object, wddct As Object
Dim F, arr, brr, i&, j&
F = Application.GetOpenFilename(fileFilter:="Word文件(*.doc*),*.doc*", Title:="选择Word文件", MultiSelect:=True)
If TypeName(F) = "Boolean" Then
Exit Sub
Else
FPATH = Replace(F(1), Dir(F(1)), "")
End If
F = Dir(FPATH & "*.doc*")
Set NEWD = CreateObject("Word.Application")
Do Until F = "" '只要文件名存在
F = FPATH & F
Set WD = NEWD.Documents.Open(Filename:=F)
With WD
On Error Resume Next
'提取每个表格内容
For b = 1 To WD.Tables.Count
With .Tables(b)
r = WD.Tables(b).Rows.Count
C = WD.Tables(b).Columns.Count
ReDim arr(1 To r, 1 To C)
For i = 1 To r
For j = 1 To C
arr(i, j) = Application.Clean(WD.Tables(b).Cell(i, j).Range)
Next
Next
End With
X = Sheet1.UsedRange.Rows.Count + 1
Sheet1.Cells(X, 2).Resize(r, C) = arr
Sheet1.Cells(X, 1) = WD
Next
.Close False
End With
Set WD = Nothing
F = Dir
Loop
NEWD.Quit
Set NEWD = Nothing
Application.ScreenUpdating = True
tim2 = Timer
MsgBox Format(tim2 - tim1, "提取完成,共耗时:0.00秒"), 64, "时间统计"
End Sub
|
|