使用VBA将Word表格每行/每列中的第一行文本导入Excel答案

【问题标题】：Import first line of text in each row/col of Word table to Excel using VBA使用VBA将Word表格每行/每列中的第一行文本导入Excel
【发布时间】：2019-10-09 20:48:37
【问题描述】：

我有一个宏，用于将 Word 文件中的表格内容导入 Excel 工作表。当前脚本运行良好，但是在处理其中一列的内容变得非常冗长的文件时，此行有时会出现错误：

  .Paste Destination:=.Range("A" & r)

我不需要每列中文本的全部内容。我想将其修改为仅复制第一行文本或表格的每一行/列中定义的字符数。

有没有办法做到这一点？

这是我目前使用的脚本：

Sub GetFirstTableData()
'Note: this code requires a reference to the Word object model.
'See under the VBE's Tools|References.
Application.ScreenUpdating = False
Dim wdApp As New Word.Application, wdDoc As Word.Document
Dim strFolder As String, strFile As String, r As Long
strFolder = GetFolder: If strFolder = "" Then GoTo ErrExit
strFile = Dir(strFolder & "\*.doc", vbNormal)
While strFile <> ""
  Set wdDoc = wdApp.Documents.Open(Filename:=strFolder & "\" & strFile, AddToRecentFiles:=False, Visible:=False)
  With wdDoc
    With .Tables(1)
      With .Range.Find
        .ClearFormatting
        .Replacement.ClearFormatting
        .Text = "[^13^l]"
        .Replacement.Text = Chr(182)
        .Forward = True
        .Format = False
        .MatchWildcards = True
        .Execute Replace:=wdReplaceAll
      End With
      .Columns.Add
      .Cell(1, 8).Range.Text = Split(strFile, ".doc")(0)
      .Range.Copy
    End With
    With ActiveSheet
      r = .Cells(.Rows.Count, 1).End(xlUp).Row
      If r > 1 Then r = r + 2
      .Paste Destination:=.Range("A" & r)
    End With
    .Close SaveChanges:=False
  End With
  strFile = Dir()
Wend
ActiveSheet.UsedRange.Replace What:=Chr(182), Replacement:=Chr(10), LookAt:=xlPart, SearchOrder:=xlByRows
ErrExit:
wdApp.Quit
Set wdDoc = Nothing: Set wdApp = Nothing
Application.ScreenUpdating = True
End Sub

Function GetFolder() As String
    Dim oFolder As Object
    GetFolder = ""
    Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
    If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
    Set oFolder = Nothing
End Function

【问题讨论】：

标签： excel vba import ms-word

【解决方案1】：

原来发生错误是因为正在解析的表格中嵌入了表格，而不是由于单元格中文本正文的长度。

在处理带有嵌入表的 .docx 文件期间，此行会发生挂断：

.Paste Destination:=.Range("A" & r)

一旦从文件中删除表格，宏就会像冠军一样工作！

【讨论】：