繁体   English   中英

将Word文档数据导入Excel(多个文档)

[英]Importing Word Document Data into Excel (Multiple Documents)

所有,

我如何修改下面的代码,不仅可以抓取每个Word文档在特定文件夹中的第一个表格,还可以从每个文档中提取所有表格? 我已经尝试过自己处理代码,但似乎无法正确处理。 任何帮助将不胜感激。

Option Explicit

Sub test()

Dim oWord As Word.Application
Dim oDoc As Word.Document
Dim oCell As Word.Cell
Dim sPath As String
Dim sFile As String
Dim r As Long
Dim c As Long
Dim Cnt As Long

Application.ScreenUpdating = False

Set oWord = CreateObject("Word.Application")

sPath = "C:\Users\Domenic\Desktop\" 'change the path accordingly

If Right(sPath, 1) <> "\" Then sPath = sPath & "\"

sFile = Dir(sPath & "*.doc")

r = 2 'starting row
c = 1 'starting column
Cnt = 0
Do While Len(sFile) > 0
Cnt = Cnt + 1
Set oDoc = oWord.Documents.Open(sPath & sFile)
For Each oCell In oDoc.Tables(1).Range.Cells
    Cells(r, c).Value = Replace(oCell.Range.Text, Chr(13) & Chr(7), "")
    c = c + 1
Next oCell
oDoc.Close savechanges:=False
r = r + 1
c = 1
sFile = Dir
Loop

Application.ScreenUpdating = True

If Cnt = 0 Then
   MsgBox "No Word documents were found...", vbExclamation
End If

End Sub
Dim tbl

'........
Set oDoc = oWord.Documents.Open(sPath & sFile)
For each tbl in oDoc.Tables
    For Each oCell In tbl.Range.Cells
        Cells(r, c).Value = Replace(oCell.Range.Text, Chr(13) & Chr(7), "")
        c = c + 1
    Next oCell
    r = r + 2 'couple of blank rows between tables
    c = 1
Next tbl

oDoc.Close savechanges:=False
'.........

暂无
暂无

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM