我想在一個單獨的 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
此代碼創建一個輸出檔案夾,其中沒有檔案并且檔案未更改(頁眉和頁腳仍然完好無損)
請問我做錯了什么?
uj5u.com熱心網友回復:
更像這樣:
'...
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
'...
轉載請註明出處,本文鏈接:https://www.uj5u.com/yidong/437787.html
下一篇:使用點標簽更改圖表中的列顏色
