1

全部,

如何修改下面的代码,不仅可以获取特定文件夹中每个 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
4

1 回答 1

1
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
'.........
于 2013-09-24T00:09:42.843 回答