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

相关文章推荐

从未表白的脆皮肠 · 必应广告 API 操作错误代码 - ...· 1 月前 ·

斯文的皮带 · vbscript错误代码及对应解释大全_80 ...· 1 月前 ·

谦逊的针织衫 · 终于喝到KOI啦，给他家的芋圆疯狂打call ...· 5 月前 ·

瘦瘦的马克杯 · 中华法文化的历史渊源与现代传承-中国法院网· 7 月前 ·

斯文的电影票 · 「 LaTex ...· 1 年前 ·

想出家的萝卜 · 中华人民共和国对外贸易经济合作部公告2001 ...· 1 年前 ·

侠义非凡的高山 · 刚刚！又一城地铁规划正式批复！合肥地铁第三轮 ...· 1 年前 ·

腾讯云

开发者社区

文档意见反馈控制台

首页 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

推荐文章

从未表白的脆皮肠 · 必应广告 API 操作错误代码 - Microsoft Advertising API | Microsoft Learn

1 月前

斯文的皮带 · vbscript错误代码及对应解释大全_800a0035

1 月前

谦逊的针织衫 · 终于喝到KOI啦，给他家的芋圆疯狂打call！特别是芋圆鲜奶

5 月前

瘦瘦的马克杯 · 中华法文化的历史渊源与现代传承-中国法院网

7 月前

斯文的电影票 · 「 LaTex 」写论文，插入表格：双栏跨栏和单栏_latex表格跨栏-CSDN博客

1 年前

想出家的萝卜 · 中华人民共和国对外贸易经济合作部公告2001年第44号——《出口国营贸易管理货物名录》、《出口国营贸易企业名录》

1 年前

侠义非凡的高山 · 刚刚！又一城地铁规划正式批复！合肥地铁第三轮规划曝出新进展！

1 年前

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

2 个回答