Save Document with Legacy Form field using bookmarks

[Thyme2Cook]

Hi I am very new at VBA and this is my first post on any VBA forum. So, please forgive any obvious errors.

I am working in a word document that is populated with Legacy form fields. It is intended to be used as the basis as a participant summary by at least 26 different staff members who will save a local copy to their folder and then save to a network location with the save date appended to the file name and macros stripped. There is also a button at the bottom of the form that will trigger the VBA and

I've been able to run a Save As function into the network location with a Now() date appended to the file name, but I need help with an If Then Else statement to determine if the user has already saved their local file with the correct naming convention (Lastname.Firstname.ID.PSDU) instead of saving over the original file name of "Participant Summary". The code below is after the addition of the If statement so it may not look like it was working the way I said. Thank you in advance for any assistance.

1. Sub SavePSDU()
2. ActiveDocument.Bookmarks("Part_LN").Select
3. ActiveDocument.Bookmarks("Part_FN").Select
4. ActiveDocument.Bookmarks("Part_ID").Select
5. NewPSDU = Part_LN & "." & Part_FN & "." & Part_ID & ".PSDU"
6. If Mid(ActiveDocument.Name, 1, Len(ActiveDocument.Name) - 5) = "Participant Summary" Then
7. ActiveDocument.SaveAs2 NewPSDU, FileFormat:=wdFormatDocumentMacroEnabled
8. Else ActiveDocument.Save
9. End If
10. CurrentNm = Mid(ActiveDocument.Name, 1, Len(ActiveDocument.Name) - 5)
11. SaveDate = Format(Now(), "yyyy-mm-dd")
12. SaveNm = "\\NetworkShare\Data Log Files" & CurrentNm & "-" & SaveDate & ".docx"
13. Dim wdApp As Word.Application
14. Set wdApp = GetObject(, "Word.Application")
15. wdApp.ActiveDocument.SaveAs SaveNm, FileFormat:=wdFormatDocumentDefault
16. wdApp.ActiveDocument.Close
17. End Sub
18. Private Sub CommandButton1_Click()
19. SavePSDU
20. End Sub

[macropod]

If your users were working with a "Participant Summary" template instead of a document, there's be little risk of them saving over your template, since the first time they saved they would be presented with a SaveAs dialogue to save the document in the docx format, which automatically strips any macros from it.

Your attempt to save the document in the wdFormatDocumentMacroEnabled format is likely to fail, since there is no such format; I suspect you meant wdFormatXMLDocumentMacroEnabled, but even that would be misleading, since it implies the document contains macros and, in any event, you're giving the document a docx extension.

With the use of a template, your SavePSDU macro could probably be reduced to:

Sub SavePSDU()
Dim StrPSDU As String
With ActiveDocument
  If .Saved = True Then Exit Sub
  StrPSDU = .Bookmarks("Part_LN").Range.Text & "."
  StrPSDU = StrPSDU & .Bookmarks("Part_FN").Range.Text & "."
  StrPSDU = StrPSDU & Bookmarks("Part_ID").Range.Text & ".PSDU"
  .SaveAs2 "\\NetworkShare\Data Log Files\" & StrPSDU & "-" & Format(Now(), "yyyy-mm-dd") & ".docx", _
    FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False
End With
End Sub

[gmayor]

There are some strange anomalies in your code, which I assume you are running from the document itself? That being the case there is no need to setup a new version of Word to save the file, and if not then the rest of the code will need to be addressed.

Given the propensity for users to enter the wrong things in fields, you need to ensure that the fields are completed and that what is entered does not include illegal filename characters. The following will address those concerns with a code sample that you can find on my web site.

The code will not overwrite the original DOCM format file and saving as DOCX will strip the macros.

Sub SavePSDU()
Dim strName As String, strDate As String
Dim strLN As String, strFN As String, strID As String
Dim oFF As FormField
    For Each oFF In ActiveDocument.FormFields
        If oFF.Name = "Part_LN" Then
            strLN = oFF.Result
            If strLN = "" Then
                MsgBox "Complete the field " & oFF.Name
                oFF.Select
                GoTo lbl_Exit
            End If
        End If
        If oFF.Name = "Part_FN" Then
            strFN = oFF.Result
            If strFN = "" Then
                MsgBox "Complete the field " & oFF.Name
                oFF.Select
                GoTo lbl_Exit
            End If
        End If
        If oFF.Name = "Part_ID" Then
            strID = oFF.Result
            If strID = "" Then
                MsgBox "Complete the field " & oFF.Name
                oFF.Select
                GoTo lbl_Exit
            End If
        End If
    Next oFF
    strName = strLN & "." & strFN & "." & strID & ".PSDU"
    strDate = Format(Now(), "yyyy-mm-dd")
    strName = strName & "-" & strDate & ".docx"
    strName = CleanFileName(strName, ".docx")
    strName = "\\NetworkShare\Data Log Files\" & strName
    'Debug.Print strName
    ActiveDocument.SaveAs2 FileName:=strName, FileFormat:=wdFormatXMLDocument
lbl_Exit:
    Exit Sub
End Sub

Private Function CleanFileName(strFilename As String, strExtension As String) As String
'Graham Mayor
'A function to ensure there are no illegal filename
'characters in a string to be used as a filename
'strFilename is the filename to check
'strExtension is the extension of the file
Dim arrInvalid() As String
Dim vfName As Variant
Dim lng_Name As Long
Dim lng_Ext As Long
Dim lngIndex As Long
    'Ensure there is no period included with the extension
    strExtension = Replace(strExtension, Chr(46), "")
    'Record the length of the extension
    lng_Ext = Len(strExtension)

    'Remove the path from the filename if present
    If InStr(1, strFilename, Chr(92)) > 0 Then
        vfName = Split(strFilename, Chr(92))
        CleanFileName = vfName(UBound(vfName))
    Else
        CleanFileName = strFilename
    End If

    'Remove the extension from the filename if present
    If Right(CleanFileName, lng_Ext + 1) = "." & strExtension Then
        CleanFileName = Left(CleanFileName, InStrRev(CleanFileName, Chr(46)) - 1)
    End If

    'Define illegal characters (by ASCII CharNum)
    arrInvalid = Split("9|10|11|13|34|42|47|58|60|62|63|92|124", "|")
    'Add the extension to the filename
    CleanFileName = CleanFileName & Chr(46) & strExtension
    'Remove any illegal filename characters
    For lngIndex = 0 To UBound(arrInvalid)
        CleanFileName = Replace(CleanFileName, Chr(arrInvalid(lngIndex)), Chr(95))
    Next lngIndex
lbl_Exit:
    Exit Function
End Function

[Thyme2Cook]

If your users were working with a "Participant Summary" template instead of a document, there's be little risk of them saving over your template, since the first time they saved they would be presented with a SaveAs dialogue to save the document in the docx format, which automatically strips any macros from it.

I was originally trying to use a document template for that very reason, but being so new to VBA I felt like I was having issues with the Macro being ported over to the new document. Plus wanted the new document to have the command button still on it so that any updates can be saved to it and when the user clicks the button it creates a Docx version in the network share while at the same time saving the updated document to the user's local folder.
The result of your code added the words "FORMTEXT" and a space before each of the FormField values. MacroResult.jpg (I used your username and time of your post as test values). I like the simplicity of your code and I think I was able to glean some understanding of how VBA works because it looks like you're building the StrPSDU incrementally instead of as one initial declaration. However, I don't see how to remove the FORMTEXT from the file name.

[Thyme2Cook]

which I assume you are running from the document itself? That being the case there is no need to setup a new version of Word to save the file, and if not then the rest of the code will need to be addressed.

I am running it from the document through a Command button at the bottom of the form. The following code fulfilled the basic need with the following actions:
1. Save the local file with the current name, Macros enabled. (users will need to update client information in the PSDU periodically)
2. Save a copy of the file with the current name and today's date appended to the name in the network share.
3. Close the application

I moved on from that because I realized that users may simply click the button for each of their updates the overwriting the PSDU's with files that are named "PSDU Template-2018-02-27" if they don't save their file with the correct naming convention before clicking the button. Since the Naming convention for the file name is made up of data entered into the Form Fields I figured a click of the button can check to see if the file name is "PSDU Template" and if true then do a save as using the form fields. Else it would simply save the local version of the file and then save a copy to the network location while stripping out the macros.

Given the propensity for users to enter the wrong things in fields, you need to ensure that the fields are completed and that what is entered does not include illegal filename characters. The following will address those concerns with a code sample that you can find on my web site.

WOW! I have so much to learn. I already checked out your site I have bookmarked it for further reading.

There are some strange anomalies in your code,

I went back in my version history and realized that I posted the code that I had thoroughly messed up by adding funky stuff. Here is the code I used that actually did the basic functions without any form fields or If statements or anything else that I'm merely guessing at.

Sub SavePSDU()    ActiveDocument.Save
    CurrentNm = Mid(ActiveDocument.Name, 1, Len(ActiveDocument.Name) - 5)
    SaveDate = Format(Now(), "yyyy-mm-dd")
    SaveNm = "\\NetworkShare\Data Log Files\" & CurrentNm & "-" & SaveDate & ".docx"
    Dim wdApp As Word.Application
    Set wdApp = GetObject(, "Word.Application")
    wdApp.ActiveDocument.SaveAs SaveNm, FileFormat:=wdFormatDocumentDefault
    wdApp.ActiveDocument.Close
    
    
End Sub


Private Sub CommandButton1_Click()
SavePSDU
End Sub

[Thyme2Cook]

Graham,

Since your code doesn't save a local DOCM formatted copy what do I need to change about this code to make it work?

Dim currrentName As String
Dim LocalFilename As String
LocalFilename = strLN & "." & strFN & "." & strID & ".PSDU"
currrentName = Mid(ActiveDocument.Name,1, Len(ActiveDocument.Name) - 5)
    If currrentName = "PSDU Template" Then ActiveDocument.SaveAs2 FileName:=LocalFilename, FileFormat:=wdFormatXMLDocumentMacroEnabled
    Else ActiveDocument.Save
    End If

[macropod]

The result of your code added the words "FORMTEXT" and a space before each of the FormField values.

Try:

Sub SavePSDU()
Dim StrPSDU As String
With ActiveDocument
  If .Saved = True Then Exit Sub
  StrPSDU = .FormFields("Part_LN").Result & "."
  StrPSDU = StrPSDU & .FormFields("Part_FN").Result & "."
  StrPSDU = StrPSDU & .FormFields("Part_ID").Result & ".PSDU"
  .SaveAs2 "\\NetworkShare\Data Log Files\" & StrPSDU & "-" & Format(Now(), "yyyy-mm-dd") & ".docx", _
    FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False
End With
End Sub

[Thyme2Cook]

Paul, your code worked to make the right file name. But I still need to save the file twice, once as a local file (Lastname.Firstname.ID.PSDU) and once to the network drive with today's date appended. So after educating myself and researching options I added a private function that prompts the user for a folder location to save their local file. Now I get the following error at "sItem = .SelectedItems(1)"
VB Error.png

I'm certain that I used the If statement wrong at line 4. I can't figure out how to tell it to save if ".Saved = True". Do I even need to really worry about that?

Here's what I have.

Sub SavePSDU()
Dim StrPSDU As String
With ActiveDocument
    If .Saved = False Then GetFolder
        StrPSDU = .FormFields("Part_LN").Result & "."
        StrPSDU = StrPSDU & .FormFields("Part_FN").Result & "."
        StrPSDU = StrPSDU & .FormFields("Part_ID").Result & ".PSDU"
        .SaveAs2 sItem & StrPSDU & "-" & Format(Now(), "yyyy-mm-dd") & ".docx", _
        FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=True
    CurrentNm = Mid(ActiveDocument.Name, 1, Len(ActiveDocument.Name) - 5)
    .SaveAs2 "\\NetworkShare\Data Log Files\" & CurrentNm & "-" & Format(Now(), "yyyy-mm-dd") & ".docx", _
    FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False
  .Close
End With
End Sub

Private Function GetFolder()
Dim fldr As FileDialog
Dim sItem As String
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
    .Title = "Select a Folder for PSDU"
    .AllowMultiSelect = False
    .InitialFileName = strPath
    'If .Show <> -1 Then GoTo NextCode
    sItem = .SelectedItems(1)
End With
NextCode:
GetFolder = sItem
Set fldr = Nothing
End Function

Private Sub CommandButton1_Click()
SavePSDU
End Sub

Thanks for all your help,
Chris

[macropod]

In that case, all you need is two SaveAs2 lines - one for each name & location. From what you've described, there is no need for a dialogue.

[Thyme2Cook]

In that case, all you need is two SaveAs2 lines - one for each name & location. From what you've described, there is no need for a dialogue.

I have two SaveAs2 lines. Do I need to remove the "If .Saved = False" line?

Also, without the dialog, how do I get the folder location to know what path to put in the SaveAs2 line?

[Thyme2Cook]

If I go that route then I could just use this simpler code and not use any of the bookmarked form fields.

Sub SavePSDU()
Dim StrPSDU As String
With ActiveDocument
    .Save
    CurrentNm = Mid(ActiveDocument.Name, 1, Len(ActiveDocument.Name) - 5)
    .SaveAs2 "\\NetworkShare\Data Log Files\" & CurrentNm & "-" & Format(Now(), "yyyy-mm-dd") & ".docx", _
    FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False
  .Close
End With
End Sub




Private Sub CommandButton1_Click()
SavePSDU
End Sub

[macropod]

In post #8 you said:

I still need to save the file twice, once as a local file (Lastname.Firstname.ID.PSDU) and once to the network drive with today's date appended.

So far, the code you've posted has only indicated the file being saved twice to the network drive with today's date appended. How is the local path to be determined? Is it, for example, the path to the originally-opened document? And what filename is the date to be appended to - the original document's filename or the string represented by StrPSDU?

[Thyme2Cook]

How is the local path to be determined? Is it, for example, the path to the originally-opened document?

At this point I don't know where the user will be saving their local copies. The purpose of the Private Function GetFolder() was to prompt the user for the location that they wanted to use for their local copy. This is only needed if they are creating a new document from the template I have created. When a user is creating a new PSDU, they will double click the "PSDU Template.DOTM" and complete the form. When they the button on the form, the VBA script should prompt for the folder location they want to save it to, and after they have done that, the script will do a save as to the local folder that the user selected. The name of that local file will be "LastName.FirstName.PartID.PSDU.docx". Then the script will do another save as to the network share folder with the same name, but the date added to it "LastName.FirstName.PartID.PSDU.20180228".

The expectation is that, after the PSDU has been created, the user will need to access the local copy to update or change the information on the PSDU and then, through the use of this code, save the local copy to its current location and then save a copy to the network folder, using the same file name as the local copy, but with the save date appended to the end of the file name.

The end result is that there is only one version of the PSDU as a local copy, but there can be multiple versions of the PSDU, with save dates appended, on the network share.

And what filename is the date to be appended to - the original document's filename or the string represented by StrPSDU?

If the user doesn't save the new document before clicking the button then the date will be appended to the string represented by StrPSDU. If the user does save before clicking the button, then the date will be appended to the original filename, what I called CurrentNm in the code.

[Thyme2Cook]

So far, the code you've posted has only indicated the file being saved twice to the network drive with today's date appended.

Additionally, since I'm using a Document template, the .Save function works to prompt the user for their own file name and location. I am trying to automate that.

[macropod]

Try:

Sub SavePSDU()
Dim StrPSDU As String, strFolder As String
With ActiveDocument
  If .Saved = True Then Exit Sub
  StrFlNm = Split(.FullName, ".doc")(0)
  StrPSDU = .FormFields("Part_LN").Result & "."
  StrPSDU = StrPSDU & .FormFields("Part_FN").Result & "."
  StrPSDU = StrPSDU & .FormFields("Part_ID").Result & ".PSDU"
  .SaveAs2 FileName:="\\NetworkShare\Data Log Files\" & StrPSDU & "-" & Format(Now(), "yyyy-mm-dd") & ".docx", _
    FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False
  strFolder = GetFolder
  If strFolder <> "" Then
    .SaveAs2 FileName:=strFolder & "\" & StrPSDU & ".docx", FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False
  End If
End With
End Sub

Function GetFolder() As String
Dim oFolder As Object
GetFolder = ""
Set oFolder = CreateObject("Shell.Application").BrowseForFolder(0, "Choose a folder", 0)
If (Not oFolder Is Nothing) Then GetFolder = oFolder.Items.Item.Path
Set oFolder = Nothing
End Function

If the user doesn't select a local folder, the network copy is saved anyway.

[Thyme2Cook]

Got it to work perfectly. Thanks for your help.

Sub SavePSDU()
Dim StrPSDU As String, strFolder As String
Dim i As Integer
With ActiveDocument
  If .Saved = True Then
    CurrentNm = Mid(ActiveDocument.Name, 1, Len(ActiveDocument.Name) - 5)
    .SaveAs2 "\\NetworkShare\Data Log Files\" & CurrentNm & "." & Format(Now(), "yyyy-mm-dd") & ".docx", _
    FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False
    .Close
    Exit Sub
  Else
    StrFlNm = Split(.FullName, ".doc")(0)
    StrPSDU = .FormFields("Part_LN").Result & "."
    StrPSDU = StrPSDU & .FormFields("Part_FN").Result & "."
    StrPSDU = StrPSDU & .FormFields("Part_ID").Result & ".PSDU"
    strFolder = GetFolder
    If strFolder <> "" Then
      .SaveAs2 FileName:=strFolder & "\" & StrPSDU & ".docx", FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=True
    .SaveAs2 FileName:="\\NetworkShare\Data Log Files\" & StrPSDU & "." & Format(Now(), "yyyy-mm-dd") & ".docx", _
      FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False
    End If
  End If
  .Close
End With
End Sub


Function GetFolder() As String
Dim sFolder As String
    ' Open the select folder prompt
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Title = "Select a Folder for Local Copy"
        .ButtonName = "Select"
        If .Show = -1 Then ' if OK is pressed
            sFolder = .SelectedItems(1)
        End If
    End With
GetFolder = sFolder
End Function


Private Sub CommandButton1_Click()
SavePSDU
End Sub

Cheers,
Chris