使用 VBA 宏从多个 word 文件中删除页眉和页脚

Question

我想在一个单独的 word 文件中使用一个宏来删除一个文件夹中多个文件的页眉和页脚。

我想要但没有必要的是将结果输出到另一个文件夹（可以是子文件夹）

'
' RemoveHeadAndFoot Macro
'
'
Application.ScreenUpdating = False
Dim strInFold As String, strOutFold As String, strFile As String, strOutFile As String, DocSrc As Document
Dim oSec As Section
Dim oHead As HeaderFooter
Dim oFoot As HeaderFooter
  
'Call the GetFolder Function to determine the folder to process
strInFold = GetFolder
If strInFold = "" Then Exit Sub
strFile = Dir(strInFold & "\*.doc", vbNormal)
'Check for documents in the folder - exit if none found
If strFile <> "" Then strOutFold = strInFold & "\Output\"
'Test for an existing outpfolder & create one if it doesn't already exist
If Dir(strOutFold, vbDirectory) = "" Then MkDir strOutFold
strFile = Dir(strInFold & "\*.doc", vbNormal)
'Process all documents in the chosen folder
While strFile <> ""
  Set DocSrc = Documents.Open(FileName:=strInFold & "\" & strFile, AddTorecentFiles:=False, Visible:=False)
  With ActiveDocument.Sections(1)
        .Headers(wdHeaderFooterPrimary).Range.Delete
        .Footers(wdHeaderFooterPrimary).Range.Delete
        
    'remove personal information
     '.RemoveDocumentInformation (wdRDIDocumentProperties)
    'String variable for the output filenames
    ' strOutFile = strOutFold & Split(.Name, ".")(0)
    'Save and close the document
    '.SaveAs FileName:=strOutFile
   ' .Close
  End With
  strFile = Dir()
Wend
'Set Rng = Nothing: Set DocSrc = Nothing
Application.ScreenUpdating = True
End Sub


Function GetFolder(Optional Title As String, Optional RootFolder As Variant) As String
On Error Resume Next
GetFolder = CreateObject("Shell.Application").BrowseForFolder(0, Title, 0, RootFolder).Items.Item.Path
End Function

这段代码创建了一个没有文件的输出文件夹，文件没有改变（页眉和页脚仍然完好无损）

请问我做错了什么？

Answer 1

更多类似内容：

'...
While strFile <> ""
    Set DocSrc = Documents.Open(FileName:=strInFold & "\" & strFile, _
                                 AddTorecentFiles:=False, Visible:=False)
    With DocSrc
        .Sections(1).Headers(wdHeaderFooterPrimary).Range.Delete
        .Sections(1).Footers(wdHeaderFooterPrimary).Range.Delete
        
        .RemoveDocumentInformation wdRDIDocumentProperties
        
        strOutFile = strOutFold & Split(.Name, ".")(0) 'no extension?
        .SaveAs FileName:=strOutFile
        .Close
    End With      
    strFile = Dir()
Wend
'...

使用 VBA 宏从多个 word 文件中删除页眉和页脚

Deleting Header and Footer from multiple word files using VBA macro

vba

ms-word