Microsoft Office Forums - View Single Post - [Solved] Fieldupdate before saving and save document where documentname is resut of field values

gmayor · 03-02-2015, 12:20 AM

OK, now we are getting somewhere

You can remove the button as it is not required and adds an unnecessary step. However you must add unique titles to each of the content controls.

Delete the code from the ThisDocument module and replace the code in the NewMacros folder of the document with the following (I would rename the module to 'modMain' but it will work without). You will have to translate the message box texts to Dutch and ensure that you use the names shown for the titles of the two fields that make up the name.

The code includes two simple standard functions, to get the pathname and to update the fields (which you can use in your projects), a function to get the name from the fields and a pair of macros to intercept the Save and SaveAs commands.

Save the document as a macro enabled template and create new documents from it.

When the user clicks Save or SaveAs the code runs

Code:

Option Explicit
Sub FileSave()
    Call FileSaveAs
lbl_Exit:
    Exit Sub
End Sub

Sub FileSaveAs()
Dim iAsk As Long
Dim strPath As String
Dim oCC As ContentControl
    For Each oCC In ActiveDocument.ContentControls
        If oCC.Title = "Geboortenaam" Or oCC.Title = "SAP nummer" Then
            If oCC.Range.Text = oCC.PlaceholderText Then
                MsgBox "Complete the '" & oCC.Title & "' field"
                GoTo lbl_Exit
            End If
        End If
    Next oCC
    UpdateAllFields
    iAsk = MsgBox("Save as PDF Format?", vbYesNoCancel)
    strPath = BrowseForFolder("Select the folder to save the document")
    Select Case iAsk
        Case vbYes
            ActiveDocument.SaveAs2 FileName:=strPath & GetFilename(ActiveDocument) & ".pdf", Fileformat:=wdFormatPDF
        Case vbNo
            ActiveDocument.SaveAs2 FileName:=strPath & GetFilename(ActiveDocument) & ".docx", Fileformat:=wdFormatXMLDocument
        Case Else
            MsgBox "Document Not Saved!"
    End Select
lbl_Exit:
    Exit Sub
End Sub

Sub UpdateAllFields()
Dim oStory As Range
    For Each oStory In ActiveDocument.StoryRanges
        oStory.Fields.Update
        If oStory.StoryType <> wdMainTextStory Then
            While Not (oStory.NextStoryRange Is Nothing)
                Set oStory = oStory.NextStoryRange
                oStory.Fields.Update
            Wend
        End If
    Next oStory
    Set oStory = Nothing
lbl_Exit:
    Exit Sub
End Sub

Function GetFilename(oDoc As Document) As String
Dim oCC As ContentControl
Dim strName As String
Dim strNumber As String
Dim strDate As String
    With oDoc
        For Each oCC In .ContentControls
            If oCC.Title = "Geboortenaam" Then strName = oCC.Range.Text
            If oCC.Title = "SAP nummer" Then strNumber = oCC.Range.Text
        Next oCC
        strDate = Format(Date, "yyyymmdd")
        GetFilename = "VBP " & strDate & Chr(32) & strName & Chr(32) & strNumber
    End With
lbl_Exit:
    Exit Function
End Function

Function BrowseForFolder(Optional strTitle As String) As String
Dim fDialog As FileDialog
    On Error GoTo err_Handler
    Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
    With fDialog
        .Title = strTitle
        .AllowMultiSelect = False
        .InitialView = msoFileDialogViewList
        If .Show <> -1 Then GoTo err_Handler:
        BrowseForFolder = fDialog.SelectedItems.Item(1) & Chr(92)
    End With
lbl_Exit:
    Exit Function
err_Handler:
    BrowseForFolder = vbNullString
    Resume lbl_Exit
End Function