编辑标题内的 MS Word 表格

发布于 2025-01-14 17:01:08 字数 1879 浏览 4 评论 0原文

我正在尝试创建一个宏来编辑 MS Word 标题中表格的单元格,标题仅包含一个表格,该表格在我正在使用的所有文档中具有相同的信息。我有一个文本,我想用它覆盖 Excel 文件中存储的现有文本,并希望能够循环浏览指定文件夹中的所有 Word 文档、编辑标题、保存、关闭和重复。我的 VBA 经验很少,但我根据我发现的类似论坛帖子拼凑了一些代码。感谢那些迄今为止提供帮助的人,他们创建了一个新问题来解决我在合并推荐的代码编辑后收到的一些新的和不同的错误。

我收到一个错误,我似乎无法理解或修复以下行:错误 5941 - 请求的集合成员不存在。似乎一旦打开 Word 文档,标题就无法被识别,但我不完全确定这个问题。

With oWordDoc.Sections(1)... 

任何帮助或见解将不胜感激,因为这对我来说都是全新的。谢谢!

到目前为止的代码:

Sub UpdateSpecHeaders()
Dim oWordApp As Object
Dim oWordDoc As Object
Dim sFolder As String, strFilePattern As String
Dim strFileName As String, sFileName As String

'> Folder containing files to update
sFolder = Range("A20").Value

'> Identify file extension to search for
strFilePattern = "*.doc"

'> Establish a Word application object
On Error Resume Next
Set oWordApp = GetObject(, "Word.Application")

If Err.Number <> 0 Then
    Set oWordApp = CreateObject("Word.Application")
End If
Err.Clear
On Error GoTo 0

oWordApp.Visible = True

Application.ScreenUpdating = False

'> Loop through the folder to get the word files
strFileName = Dir$(sFolder & strFilePattern)
Do Until strFileName = ""
    sFileName = sFolder & strFileName 

    '> Open the word doc
    Set oWordDoc = oWordApp.Documents.Open(sFileName)
           
    '> Update Header     
    With oWordDoc.Sections(1).Headers(wdHeaderFooterPrimary).Range.Tables(1).Range
            .Cells(Row:=3, Column:=1).Text = Range("A3").Value
            .Cells(Row:=3, Column:=2).Text = Range("B3").Value
    End With
      
    '> Save and close the file
    oWordDoc.SaveAs Filename:=oWordDoc.Name
    oWordDoc.Close SaveChanges:=False
        
    '> Find next file
    strFileName = Dir$()
Loop

'> Quit and clean up
Application.ScreenUpdating = True
oWordApp.Quit

Set oWordDoc = Nothing
Set oWordApp = Nothing

End Sub

I'm trying to create a macro to edit the cells of a table within a MS Word header, the headers only contain a table with the same information in all the documents I'm working with. I have the text with which I'd like to overwrite the existing text stored in an Excel file and hope to be able to cycle through all of the word docs within a specified folder, edit the headers, save, close and repeat. My VBA experience is slim to none but I've cobbled together some code based upon similar forum posts I've found. Thank you to those who've helped so far, creating a new question to address some of the new and different errors I'm receiving after incorporating recommended code edits.

I'm getting an error I can't seem to understand or fix on the line below: Error 5941 - Requested member of the collection does not exist. It seems like once the Word doc is opened, the header is not being recognized but I'm not entirely sure of the issue.

With oWordDoc.Sections(1)... 

Any help or insight would be much appreciated as this is all quite new to me. Thanks!

Code so far:

Sub UpdateSpecHeaders()
Dim oWordApp As Object
Dim oWordDoc As Object
Dim sFolder As String, strFilePattern As String
Dim strFileName As String, sFileName As String

'> Folder containing files to update
sFolder = Range("A20").Value

'> Identify file extension to search for
strFilePattern = "*.doc"

'> Establish a Word application object
On Error Resume Next
Set oWordApp = GetObject(, "Word.Application")

If Err.Number <> 0 Then
    Set oWordApp = CreateObject("Word.Application")
End If
Err.Clear
On Error GoTo 0

oWordApp.Visible = True

Application.ScreenUpdating = False

'> Loop through the folder to get the word files
strFileName = Dir$(sFolder & strFilePattern)
Do Until strFileName = ""
    sFileName = sFolder & strFileName 

    '> Open the word doc
    Set oWordDoc = oWordApp.Documents.Open(sFileName)
           
    '> Update Header     
    With oWordDoc.Sections(1).Headers(wdHeaderFooterPrimary).Range.Tables(1).Range
            .Cells(Row:=3, Column:=1).Text = Range("A3").Value
            .Cells(Row:=3, Column:=2).Text = Range("B3").Value
    End With
      
    '> Save and close the file
    oWordDoc.SaveAs Filename:=oWordDoc.Name
    oWordDoc.Close SaveChanges:=False
        
    '> Find next file
    strFileName = Dir$()
Loop

'> Quit and clean up
Application.ScreenUpdating = True
oWordApp.Quit

Set oWordDoc = Nothing
Set oWordApp = Nothing

End Sub

如果你对这篇内容有疑问,欢迎到本站社区发帖提问 参与讨论,获取更多帮助,或者扫码二维码加入 Web 技术交流群。

扫码二维码加入Web技术交流群

发布评论

需要 登录 才能够评论, 你可以免费 注册 一个本站的账号。
列表为空,暂无数据
我们使用 Cookies 和其他技术来定制您的体验包括您的登录状态等。通过阅读我们的 隐私政策 了解更多相关信息。 单击 接受 或继续使用网站,即表示您同意使用 Cookies 和您的相关数据。
原文