MS Word VBA: Saving File, runtime error 5152

Question

I posted a question recently about getting my mail merge document to split and save. After finding some code online, I was able to combine it with my own code to get the document to split and create a name that I wanted. However, now when the code goes to save the document, it puts out a 5152 error, and I have no clue on how to go about it. This is what my code looks like and the error occurs at the ActiveDocument.SaveAs filename:=Fullname, fileformat:=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

Im assuming it has to be something with how the path to the file is written because The error message reads: Run-Time error '5152': This is not a valid file name. Try one or more of the following: *Check the path to make sure it was typed coerrectly. *Select a file from the list of files and folders. — Cocoberry2526
First of all, is assessment rubrics a folder name or first words of your file name? If it is a folder name, then you should change it to "E:\assessment rubrics\". Also change fileformat to fileformat:=wdFormatXMLDocument since it has a docx extension. — Tehscript
@Tehscript I did what you said, but it is still giving the 5152 error — Cocoberry2526
Can you debug.print Fullname and share with us? It might still have restricted characters in it even if you think you replaced all of them. — Tehscript
When I do that it puts out: E:\assessment_rubrics\Templates\Program: Art-Studio Art BFA - Academic Program Review - 8/23/2017 3:04:28 PM.docx — Cocoberry2526

Tehscript Tehscript · Accepted Answer · 2017-08-23T20:10:54

cvtstr(These characters /|?*<>:"\ are not allowed in your filename. Use the function below:

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

and then your code should be:

    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_rubrics\Templates\"

    FullName = filepath & filename & ".docx"

EDIT:

It is not a good practice to combine filepath and filename, but since you extract it from the paragraph, until you find a better solution to improve your code, you can do the following:

Use the function below:

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

and use the following lines in your code

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

MS Word VBA: Saving File, runtime error 5152

2 Answers