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

Question

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

1. 我想要但不必要的是将结果输出到另一个文件夹（它可能是子文件夹）

'
' 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
'...