MS Word VBA:保存文件，运行时错误 5152

Question

我最近发布了一个关于让我的邮件合并文档拆分和保存的问题。在网上找到一些代码后，我能够将其与我自己的代码相结合，以使文档拆分并创建一个我想要的名称。但是，现在当代码保存文档时，它会发出 5152 错误，我不知道该怎么做。这就是我的代码的样子，错误发生在 ActiveDocument.SaveAs 文件名：=全名，文件格式：=wdFormatDocumentDefault，AddToRecentFiles：=False

Option Explicit
Sub Splitter()
' splitter Macro
' Macro created by Doug Robbins to save each letter created by a mailmergeas a separate file.
Application.ScreenUpdating = False
Dim Program As String
Dim DocName As String
Dim Letters As Integer, Counter As Integer
Dim filename, extension, Fullname, Mask As String
Letters = ActiveDocument.Sections.Count
Selection.HomeKey Unit:=wdStory
Counter = 1
While Counter < Letters
'program = ActiveDocument.MailMerge.DataSource.DataFields("Program_Outcomes_PlanReport_Name").Value
DocName = "Reports" & LTrim$(Str$(Counter))  'Generic name of document
ActiveDocument.Sections.First.Range.Cut
Documents.Add
Selection.Paste
ActiveDocument.Sections(2).PageSetup.SectionStart = wdSectionContinuous
filename = ActiveDocument.Paragraphs(1).Range.Text
filename = Replace(filename, Chr$(13), "")
filename = Replace(filename, Chr$(10), "")
filename = Replace(filename, "/", "_")
filename = Replace(filename, "&", "_")
extension = ".docx"
DocName = "E:assessment rubrics" & filename & " - Academic Program Review - " & Format(Now(), Mask)
Fullname = DocName & extension
ActiveDocument.SaveAs filename:=Fullname, fileformat:=wdFormatDocumentDefault, AddToRecentFiles:=False
ActiveWindow.Close
Counter = Counter + 1
Wend
Application.ScreenUpdating = True
End Sub

Answer 1

cvtstr(这些字符/|？*<>："\ 不允许出现在您的文件名中。使用以下函数：

Function cvtstr(strIn As String) As String
Dim i As Integer
Const str = "/|?*<>"":"
cvtstr = strIn
For i = 1 To Len(str)
cvtstr = Replace(cvtstr, Mid$(str, i, 1), " ")
Next i
End Function

然后你的代码应该是：

Dim filename As String, Fullname As String, Mask As String, filepath As String
.
.
.
filename = cvtstr(Replace(ActiveDocument.Paragraphs(1).Range.Text, "Templates", "")) 'this part is temporary solution. You actually need to distinguish filepath and filename in ActiveDocument.Paragraphs(1).Range.Text    
filename = Left(filename, Len(filename) - 1) & " - Academic Program Review - " & cvtstr(Format(Now(), Mask)))
filepath = "E:assessment_rubricsTemplates"
FullName = filepath & filename & ".docx"

编辑：

将文件路径和文件名组合在一起不是一个好的做法，但由于您从段落中提取它，因此在找到更好的解决方案来改进代码之前，您可以执行以下操作：

使用以下函数：

Function cvtstr(strIn As String) As String
Dim i As Integer
Const str = "/|?*<>"":"
cvtstr = strIn
For i = 1 To Len(str)
cvtstr = Replace(cvtstr, Mid$(str, i, 1), " ")
Next i
End Function

并在代码中使用以下行

Filename = cvtstr(ActiveDocument.Paragraphs(1).Range.Text)
Filename = Left(Filename, Len(Filename) - 1)
extension = ".docx"
DocName = "E:assessment rubrics" & Filename & " - Academic Program Review - " & cvtstr(Format(Now(), Mask)))
FullName = DocName & extension

Answer 2

这就是我的代码现在的样子

Function cvtstr(strIn As String) As String
Dim i As Integer
Const str = "/|?*<>"":"
cvtstr = strIn
For i = 1 To Len(str)
cvtstr = Replace(cvtstr, Mid$(str, i, 1), " ")
Next i
End Function

Sub Splitter()
' splitter Macro
' Macro created by Doug Robbins to save each letter created by a mailmergeas a separate file.
Application.ScreenUpdating = False
Dim Program As String
Dim DocName As String
Dim Letters As Integer, Counter As Integer
Dim filename, extension, Fullname, filepath, Mask As String
Letters = ActiveDocument.Sections.Count
Selection.HomeKey Unit:=wdStory
Counter = 1
While Counter < Letters
'program =  ActiveDocument.MailMerge.DataSource.DataFields("Program_Outcomes_PlanReport_Name").Value
DocName = "Reports" & LTrim$(str$(Counter))  'Generic name of document
ActiveDocument.Sections.First.Range.Cut
Documents.Add
Selection.Paste
'ActiveDocument.Sections(2).PageSetup.SectionStart = wdSectionContinuous
Filename = cvtstr(ActiveDocument.Paragraphs(1).Range.Text)
Filename = Left(Filename, Len(Filename) - 1)
extension = ".docx"
DocName = "E:assessment rubrics" & Filename & " - Academic Program Review - " & cvtstr(Format(Now(), Mask)))
FullName = DocName & extension
ActiveDocument.SaveAs filename:=Fullname, fileformat:=wdFormatXMLDocument, AddToRecentFiles:=False
ActiveWindow.Close
Counter = Counter + 1
Wend
Application.ScreenUpdating = True
End Sub