VBA - PasteSpecial Error и переход к следующей строке в Excel

Question

Я пытаюсь перебрать несколько документов Word в папке и добавить некоторую информацию из таблиц слов в таблицу Excel. Прямо сейчас у меня есть это:

Private Sub Loop_WordToExcel()

    Dim WdApp As Object
    Dim wddoc As Object
    Dim docName As String
    Dim strFile As String
    Dim directory As String

    directory = "c:\path\to\folder"
    strFile = Dir(directory & "*.*")
    Set WdApp = CreateObject("Word.Application")

    Dim rng As Range
    Set rng = Application.InputBox(Prompt:="Enter row", Type:=8)

    'Do While strFile <> ""

        Set wddoc = WdApp.Documents.Open(Filename:=directory & strFile)


        rng.Cells(1) = wddoc.Name

        'First Name
        wddoc.Tables(1).Cell(1, 3).Range.Copy
        rng.Cells(2).PasteSpecial (xlPasteValues)

        WdApp.ActiveDocument.Close SaveChanges:=False
        strFile = Dir

        Loop

End Sub

У меня есть два вопроса. 1. Моя первая проблема - ошибка времени выполнения «1004»: сбой метода PasteSpecial класса Range 2. В конце цикла, как перейти к следующей строке для вставки информации о документе следующего слова.

Answer 1

Правильный синтаксис при копировании из Word. Может попробовать

Sub Loop_WordToExcel()

    Dim WdApp As Word.Application
    Dim WdDoc  As Document
    Dim docName As String
    Dim strFile As String
    Dim directory As String
    Dim Rng As Range
    Dim Offst As Long, Txt As String

    directory = "C:\users\user\Desktop\Folder1\" ' Change to your path
    strFile = Dir(directory & "*.docx")          ' docx  extension added to prevent attempt to open other type of files

    Set Rng = Application.InputBox(Prompt:="Enter row", Type:=8) '


    Set WdApp = CreateObject("Word.Application")
    WdApp.Visible = True


    Do While strFile <> ""
    Set WdDoc = WdApp.Documents.Open(Filename:=directory & strFile)
    Rng.Offset(Offst, 0).Value = WdDoc.Name
    'First Name

    WdDoc.Tables(1).Cell(1, 3).Range.Copy           'will raise error if table& corres cell not exists , My use error handrel
    Rng.Offset(Offst, 1).Activate
    ActiveSheet.PasteSpecial Format:="Text", Link:=False, DisplayAsIcon:=False    'Assumed want get name in Column B

    'is is suggested to use the below two lines instead of paste special above three lines
    'Txt = WdDoc.Tables(1).Cell(1, 3).Range.Text      'will raise error if table& corres cell not exists , My use error handrel
    'Rng.Offset(Offst, 1).Value = Txt

    WdDoc.Close SaveChanges:=False
    Offst = Offst + 1
    strFile = Dir
    Loop

WdApp.Quit
End Sub

Всегда желательно добавлять ссылку на библиотеку объектов Microsoft Word.