从多个Word文档中提取数据和解决运行时错误代码“4605”所需的Excel宏修改

相关文章推荐

留胡子的红薯 · Visual Studio ...· 1 月前 ·

冷冷的芒果 · 解决Idea的Generate ...· 1 年前 ·

礼貌的皮带 · C++ 嵌套 if 语句 | 菜鸟教程· 2 年前 ·

温文尔雅的大白菜 · sqlserver运行超大sql文件_sql ...· 2 年前 ·

打盹的单车 · AgentWeb设置缓存模式(WebSett ...· 2 年前 ·

俊逸的火锅 · 框架学习 - 若依 / ...· 2 年前 ·

腾讯云

开发者社区

文档意见反馈控制台

首页 TVP

文章/答案/技术大牛

发布

Sub ImportFromWord()
On Error Resume Next
  'Activate Word Object Library
  Dim WordDoc As Word.Document
  Set WordApp = CreateObject("word.application") ' Open Word session
  WordApp.Visible = False 'keep word invisible
  Set WordDoc = WordApp.Documents.Open("C:\Users\brendan.ramsey\OneDrive - Ofcom\Objectives\Brendan's Objectives 2022-23\Licence calls\test 2.docx") ' open Word file
  'copy third row of first Word table
  WordDoc.Tables(1).Cell(Row:=1, Column:=3).Range.Copy
  'paste in Excel
  Range("A3").PasteSpecial xlPasteValues
  WordDoc.Tables(4).Cell(Row:=3, Column:=6).Range.Copy
  Range("B3").PasteSpecial xlPasteValues
  WordDoc.Tables(4).Cell(Row:=3, Column:=3).Range.Copy
  Range("C3").PasteSpecial xlPasteValues
  WordDoc.Tables(5).Cell(Row:=2, Column:=5).Range.Copy
  Range("D3").PasteSpecial xlPasteValues
  WordDoc.Tables(5).Cell(Row:=2, Column:=7).Range.Copy
  Range("E3").PasteSpecial xlPasteValues
  WordDoc.Tables(5).Cell(Row:=2, Column:=2).Range.Copy
  Range("F3").PasteSpecial xlPasteValues
  WordDoc.Close 'close Word doc
  WordApp.Quit ' close Word
End Sub

Sub ImportFromWord()
    Const FLDR_PATH As String = "C:\Temp\Docs\"
    Dim WordDoc As Word.Document, WordApp As Word.Application
    Dim rw As Range, f
    Set rw = ActiveSheet.Rows(3) 'or some other sheet
    f = Dir(FLDR_PATH & "*.doc*") 'check for document
    Do While Len(f) > 0
        If WordApp Is Nothing Then 'open word if not already open
            Set WordApp = CreateObject("word.application")
            WordApp.Visible = False
        End If
        With WordApp.Documents.Open(FLDR_PATH & f, ReadOnly:=True) ' open Word file
            WordCellToExcel .Tables(1).Cell(Row:=1, Column:=3), rw.Cells(1)
            WordCellToExcel .Tables(4).Cell(Row:=3, Column:=6), rw.Cells(2)
            WordCellToExcel .Tables(4).Cell(Row:=3, Column:=3), rw.Cells(3)
            'etc etc
            .Close savechanges:=False
        End With
        Set rw = rw.Offset(1) 'next row down
        f = Dir()             'next file, if any
    If Not WordApp Is Nothing Then WordApp.Quit ' close Word if it was opened
End Sub

从多个Word文档中提取数据和解决运行时错误代码“4605”所需的Excel宏修改

2 个回答