经常使用Word的上班族有时候会遇到这种情况，文件夹里有几十甚至上百个Word文档，老板某天突然让全部加上页眉页脚，大多数网友肯定觉得头疼，现在使用VBA就能很快地完成老板布置的任务了。这不，前段时间我就收到网友求助，需要批量给Word文档添加文件名作为页眉，下面我来讲一下该如何用Excel VBA来实现Word页眉的添加，效果可在文档末尾查看。
首先，创建一个Excel宏文件，按Alt+F11调出VBA代码界面，插入一个模块，新建一个过程Sub Main
接着，定义一下文件系统对象和文件夹对象，以便遍历文件夹里的Word文档
注：这里也可以使用Dir函数，那么就无需创建文件系统对象了
<code>Dim Fso, FolderSet Fso = CreateObject("Scripting.FileSystemObject")Set Folder = Fso.GetFolder(ThisWorkbook.Path)‘’/<code>我们再定义一下Word应用对象和Word文档对象
<code>Dim WordAppDim WordDSet WordApp = CreateObject("Word.Application")Set WordD = CreateObject("Word.Document")WordApp.Visible = False/<code>想要在程序运行时不显示Word的话，我们可以加上下面这段代码
<code>WordApp.Visible = False/<code>
接下来我们开始遍历当前文件夹，提取文件名，设置页眉、页脚
<code>For Each file In Folder.Files If file.Name Like "*.doc*" Then Set WordD = WordApp.Documents.Open(file.Path) WordD.Sections(1).Headers(1).Range.Text = getFileName(file.Name)'页眉 WordD.Sections(1).Footers(1).Range.Text = getFileName(file.Name)'页脚 WordD.Close savechanges:=True'保存后关闭 Set WordD = Nothing End IfNext/<code>
上面代码中的getFileName是我加的自定义方法，用来去掉文件名的扩展名，代码如下。网友们可以根据自己的需求选择是否调用。
<code>Function getFileName(ByVal fileFullName As String) As String getFileName = Mid(fileFullName, 1, InStr(fileFullName, ".doc") - 1)End Function/<code>
最后，我们要关闭Word应用对象
<code>WordApp.Quit/<code>
最后我们需要在Excel Sheet里添加一个按钮，指定宏为我们创建的Sub
全部代码如图：
代码全貌
效果见下图：
最终效果
在Excel中遇到问题都可以找我交流一下，喜欢的朋友记得点赞关注，以后不定期更新Excel VBA技巧！
分享到:
閱讀更多 VBA編程開發 的文章
