CODEWITHSUNDEEP
vbams-word
RockyFaher
RockyFaher

Reputation: 61

MS Word 2013 VBA Macro Function

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

Upvotes: 1

Views: 152

Answers (2)

RockyFaher
RockyFaher

Reputation: 61

The code should have been: Application.ActiveDocument.SaveAs2 (strBackUpPath & DocName & ".docx") In my defense, I will say that Microsoft is often its own worst enemy for reasons amply documented elsewhere - as for the code as originally written, it would have worked in standard VB6, BUT VBA is not VB6. To Tim Williams I offer my thanks - while technically incorrect, you put me on to the right answer, AND it's possible the concatenation, as written was being misinterpreted by the compiler. But the concatenation as rewritten was still required for reasons of efficiency and compactness. Oh, and it's working perfectly now that i have corrected my mistake! Thanks to all!

Upvotes: 0

Tim Williams
Tim Williams

Reputation: 166790

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

should be

Application.ActiveDocument.SaveAs2 strBackUpPath

Upvotes: 2

Related Questions