VBA-粘贴特殊错误并移动到Excel中的下一行

我试图循环浏览文件夹中的许多word文档，并将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

Private子循环\u WordToExcel（）
作为对象的应用程序
Dim wddoc作为对象
将docName设置为字符串
作为字符串的Dim strFile
将目录设置为字符串
directory=“c:\path\to\folder”
strFile=Dir（目录&“***”）
Set WdApp=CreateObject（“Word.Application”）
变暗rng As范围
设置rng=Application.InputBox（提示：=“输入行”，类型：=8）
“在strFile时执行”
设置wddoc=WdApp.Documents.Open（文件名：=目录和strFile）
rng.CELL（1）=wddoc.Name
“名字
wddoc.Tables（1）.单元格（1,3）.Range.Copy
rng.单元格（2）.PasteSpecial（XLPasteValue）
WdApp.ActiveDocument.Close SaveChanges:=False
strFile=Dir
环
端接头

我有两个问题。 1.我的第一个问题是运行时错误“1004”：Range类的特殊方法失败

---

2.在循环结束时，如何前进到下一行，以便粘贴下一个word文档信息。

如果给出了从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

子循环\u WordToExcel（）
将WdApp设置为Word.Application
将文档作为文档
将docName设置为字符串
作为字符串的Dim strFile
将目录设置为字符串
变暗Rng As范围
Dim Offst为长，Txt为字符串
directory=“C:\users\user\Desktop\Folder1\”更改为您的路径
添加了strFile=Dir（directory&“*.docx”）”docx扩展名，以防止尝试打开其他类型的文件
设置Rng=Application.InputBox（提示：=“输入行”，类型：=8）”
Set WdApp=CreateObject（“Word.Application”）
WdApp.Visible=True
当strFile“”时执行
设置WdDoc=WdApp.Documents.Open（文件名：=目录和strFile）
Rng.Offset（Offst，0）.Value=WdDoc.Name
“名字
WdDoc.Tables（1）.Cell（1，3）.Range.Copy'将引发错误，如果table&corres单元格不存在，我的使用错误handrel
发动机偏置（偏置，1）。激活
ActiveSheet.Paste特殊格式：=“文本”，链接：=False，显示图标：=False“假定要在B列中获取名称
建议使用下面两行，而不是粘贴上面三行
如果table&corres单元格不存在，则“Txt=WdDoc.Tables（1）.Cell（1,3）.Range.Text”将引发错误，My use error handrel
'Rng.Offset（Offst，1）.Value=Txt
WdDoc.Close SaveChanges:=False
Offst=Offst+1
strFile=Dir
环
WdApp，退出
端接头

---

始终首选添加对Microsoft Word对象库的引用。

文档名称在行的每个单元格中重复打印。有没有办法解决这个问题？因为只需要目标单元格的开始，输出取决于文件夹中文件的数量。仅选择单个单元格将防止出现这种情况。否则，可以使用

Rng（1,1）.offset（Offst，…）

i而不是

Rng.offset（Offst，

）。这些将在目标单元格的开始处处理所选内容的左上角单元格，并将找到的编号文件向下移动。