MS Word 2013 VBA Macro Function

Question

The following VBA Code will not save an open document to a sub-folder under the active 'My Documents' Folder. The code is called from App_DocumentBeforeClose and it executes without throwing a fault flag or process failed notification. All the code and save location string building works just the way its supposed to - the open document just doesn't get saved to the 'My Documents' sub-folder. The file itself is a working copy stored on a SDHC chip - could this be the problem? I have checked the folder rights and the sub-folder 'Read Only' attribute is turned off.

Public Sub SaveToTwoLocations()
Dim Res
Dim oDoc As Document, SourceFile As String, DestinationFile As String
Dim strBackUpPath As String, fDialog As FileDialog, Reps, DocName As String

If Right(ActiveWindow.Caption, 4) = "ode]" Then
    DocName = Left(ActiveWindow.Caption, Len(ActiveWindow.Caption) - 21)
ElseIf Right(ActiveWindow.Caption, 5) = ".docx" Then
    DocName = Left(ActiveWindow.Caption, Len(ActiveWindow.Caption) - 5)
End If

On Error GoTo CanceledByUser

Res = MsgBox("Save Source File?", vbQuestion + vbYesNo, "Save Original Prior to Back-Up Interrogative")
If Res = vbYes Then
    Application.ActiveDocument.Save
End If

If GetSetting("My_Books", DocName, "Save_2") = "" Then
    Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
    With fDialog
        .Title = "Select Folder to Save The Copy To & Click Ok"
        .AllowMultiSelect = False
        .InitialView = msoFileDialogViewList
        If .Show <> -1 Then
            MsgBox "Canceled By user", , "Save To Two Locatiions"
            Exit Sub
        End If
        strBackUpPath = fDialog.SelectedItems.Item(1) & "\"
        Res = MsgBox("Save File To Selected 'SaveTo' Location?", vbQuestion + vbYesNo, "'SaveTo' Interrogative")
        If Res = vbYes Then
            SaveSetting "My_Books", DocName, "Save_2", strBackUpPath
            strBackUpPath = strBackUpPath & DocName & ".docx"
            Application.ActiveDocument.SaveAs2 (strBackUpPath)
        Else
            Exit Sub
        End If
    End With

Else

    strBackUpPath = GetSetting("My_Books", DocName, "Save_2")
    Res = MsgBox("Save This Document To: " & strBackUpPath & "?", vbQuestion + vbYesNo, "Two Location Save Interrogative")
    If Res = vbYes Then
        If Right(ActiveDocument.Name, 1) = "x" Then
            Application.ActiveDocument.SaveAs2 (strBackUpPath = strBackUpPath & DocName & ".docx")
        Else
            MsgBox "Non-docx Doument File Save Error", vbCritical, "2nd Location File Save Error"
            GoTo CanceledByUser
        End If
    Else
        Set fDialog = Application.FileDialog(msoFileDialogSaveAs)
        With fDialog
            .Title = "Select Folder to Save The Copy To & Click Ok"
            .AllowMultiSelect = False
            .InitialView = msoFileDialogViewList
            If .Show <> -1 Then
                MsgBox "File Save Canceled By User", , "Save To Two Locatiions Canceled"
                Exit Sub
            End If
        End With
    End If

End If

CanceledByUser:
End Sub

This line looks wrong (with an attempted assignment in the parameter list): Application.ActiveDocument.SaveAs2 (strBackUpPath = strBackUpPath & DocName & ".docx") — user1379931
Tim Williams - The string building process must take into account the fact that the document name was truncated at [ElseIf Right(ActiveWindow.Caption, 5) = ".docx" Then] to allow matching of the Registry Key identifying the previously stored save to location - this allows me to differentiate among multiple documents currently being worked on. — RockyFaher
Does the problem occur for both ".doc" and ".docx" documents, or only the former? Because the way you are saving a ".doc" document (in the case there is no previous setting) is obviously wrong. (In the case when there is a previous setting correct the code as per @bibadia) — A.S.H
Yes it does with both types - Sorry I didn't think of it earlier, but, as a test I modified the code to save the file to the "D" drive Temp Folder as a .docx and it works so the problem is that the macro is not allowed to write files to the Document Folder and that is with the trust center settings set to enable all macros and trust acces to the VBA Project Object Model - the problem is Microsoft, as usual. Now I will have to figure out a work around because of course no one at Microsoft knows how to do it. How typical! — RockyFaher
FYI no points to be gained here by "Microsoft AMIRITE ?" comments. — Tim Williams

Tim Williams Tim Williams · Accepted Answer · 2015-12-14T18:07:58

Application.ActiveDocument.SaveAs2 (strBackUpPath = strBackUpPath & DocName & ".docx")

should be

Application.ActiveDocument.SaveAs2 strBackUpPath

MS Word 2013 VBA Macro Function

2 Answers