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.



Sub SavePSDU()
ActiveDocument.Bookmarks("Part_LN").Select
ActiveDocument.Bookmarks("Part_FN").Select
ActiveDocument.Bookmarks("Part_ID").Select
NewPSDU = Part_LN & "." & Part_FN & "." & Part_ID & ".PSDU"
If Mid(ActiveDocument.Name, 1, Len(ActiveDocument.Name) - 5) = "Participant Summary" Then
ActiveDocument.SaveAs2 NewPSDU, FileFormat:=wdFormatDocumentMacroEnabled
Else ActiveDocument.Save
End If
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

[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. 21709 (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)"
21725

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