Word按页拆分文档并以每页首行命名的VBA代码问题

你遇到的问题根源是strNewFileName变量没有在每次处理新页面时重置，导致每次循环都在之前的文件名基础上追加内容，最终出现累加所有页面首行的情况。

修正后的代码段 #

替换你修改的命名部分为以下代码：

' 获取当前页首行文本，移除末尾的段落标记
Dim strPageTitle As String
strPageTitle = Left(docSingle.Range.Paragraphs(1).Range.Text, Len(docSingle.Range.Paragraphs(1).Range.Text) - 1)

' 处理文件名非法字符（避免保存失败）
Dim illegalChar As Variant
For Each illegalChar In Array("\", "/", ":", "*", "?", """", "<", ">", "|")
    strPageTitle = Replace(strPageTitle, illegalChar, "")
Next illegalChar

' 基于原文档路径生成新文件名，每次循环重置
strNewFileName = Replace(docMultiple.FullName, docMultiple.Name, strPageTitle & ".doc")

docSingle.SaveAs strNewFileName
iCurrentPage = iCurrentPage + 1
docSingle.Close

关键说明 #

1. 每次循环都会重新提取当前页的首行文本，不会复用之前的值
2. 增加了非法字符替换逻辑，避免因首行包含系统不允许的文件名字符导致保存失败
3. 通过Replace(docMultiple.FullName, docMultiple.Name, ...)确保新文件保存在原文档的同一目录下

内容的提问来源于stack exchange，提问作者Greg