Question

我正在编写一个脚本，从Word文件中提取表格，然后将其复制到Excel中的工作表中。但是，我收到的Word文件格式不同，我需要的表格并不总是在同一页面上。因此我不能使用常规表索引。每个表都在不同的页面上，只有在那个页面上，某处是文本字符串（可能在表格中，也可能不在表格中），如材料/材料清单＆＃39;。我想要做的是扫描Word文档的每个页面以查找某个文本字符串，并且仅当该字符串存在时，才使用该页面上的相应表格。这可能吗？我将如何解决这个问题？

格式不一致的复杂性在于，在某些页面上，数据甚至不在表格中，因此对于那些文件，如果在页面上找到触发词但没有表格，我会发出警告。

编辑：

我试图重新定义所考虑的范围。我希望这是最简单的方法;查看关键字出现的位置，然后使用第一个表。然而，这似乎不起作用。

With ActiveDocument.Content.Find
    .Text = "Equipment"
    .Forward = True
    .Execute
    If .Found = True Then Set aRange = ActiveDocument.Range(Start:=0, End:=0)
End With

编辑：我试图将macropod中的代码与Excel中的vba结合起来，将表复制到工作表中。

Sub LookForWordDocs()
Dim FolderName As String
With Application.FileDialog(msoFileDialogFolderPicker)
  .AllowMultiSelect = False
  .Show
  On Error Resume Next
  FolderName = .SelectedItems(1)
  Err.Clear
  On Error GoTo 0
End With
    Dim sFoldPath As String: sFoldPath = FolderName     ' 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) Or _
         (InStr(1, LCase(oFSO.GetExtensionName(oFile.Path)), "docx", vbTextCompare) > 0)) And _
                (InStr(1, oFile.Name, "~$") = 0) And _
                ((InStr(1, oFile.Name, "k") = 1) Or (InStr(1, oFile.Name, "K") = 1)) Then
            ' Call the UDF to copy from word document
            ImpTable oFile
        End If
    Next
End Sub
Sub ImpTable(ByVal oFile As File)
Dim oWdApp As New Word.Application
Dim oWdDoc As Word.Document
Dim oWdTable As Word.Table
Dim oWS As Excel.Worksheet
Dim lLastRow$, lLastColumn$
Dim s As String
s = "No correct table found"

With Excel.ThisWorkbook
Set oWS = Excel.Worksheets.Add
On Error Resume Next
oWS.Name = oFile.Name
On Error GoTo 0
Set sht = oWS.Range("A1")

Set oWdDoc = oWdApp.Documents.Open(oFile.Path)
oWdDoc.Activate
'Application.ScreenUpdating = False
Dim StrFnd As String, Rng As Word.Range, i As Long, j As Long
j = 0
StrFnd = "equipment"
 With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = StrFnd
    .Replacement.Text = ""
    .Forward = True
    .Wrap = wdFindStop
    .Format = False
    .MatchCase = False
    .MatchWholeWord = False
    .MatchWildcards = False
    .MatchSoundsLike = False
    .MatchAllWordForms = False
    .Execute
  End With
  Do While .Find.Found
    i = .Information(wdActiveEndAdjustedPageNumber)
    Set Rng = Word.ActiveDocument.Goto(What:=wdGoToPage, Name:=i)
    Set Rng = Rng.Goto(What:=wdGoToBookmark, Name:="\page")
    If Rng.Tables.Count > 0 Then
      With Rng.Tables(1)
      Set oWdTable = Rng.Tables(1)
        oWdTable.Range.Copy
        sht.PasteSpecial xlPasteValues, xlPasteSpecialOperationNone
        j = 1
       End With
    End If
    .Start = Rng.End
    .Find.Execute
  Loop
End With
If j = 0 Then sht.Value = s
'Application.ScreenUpdating = True
oWdDoc.Close savechanges:=False
oWdApp.Quit
End With

Set oWS = Nothing
Set sht = Nothing
Set oWdDoc = Nothing
Set oWdTable = Nothing
Set Rng = Nothing

End Sub

对于第一个文件，代码工作正常。但是在第二次运行时，我得到一个运行时错误＆＃34;远程服务器机器不存在或不可用＆＃34;在线上＆＃34; Word.ActiveDocument.Range＆＃34 ;.我添加了几个元素的资格，但这仍然没有解决问题。我错过了另一条线吗？

BTW当我放置＆＃34; Word＆＃34;在ActiveDocument.Range之前，代码不再起作用。

Answer 1

由于您已从“材料/材料清单”中更改了文字。对于“设备”来说，很难知道你想要什么。尝试以下方面：

../RDL/spec/.rspec

注意：以上代码将测试找到查找文本的所有网页。

在vba

1 个答案: