VBA Novice

[JuddH99]

Hi, so I want to create a template with a few different controls in it.
Although I don't really know what I'm doing, I was able to create a Sub function that upon clicking Run would prompt to save my file with some criteria. However, this is just some code I found on the web.

What I really want is for the save file prompt to auto-populate the file name with today's date (18/06/28) and then what is selected from a drop down menu. I can Title the drop down menu as VehicleDrop.

I can't figure this out and I also cannot figure out the next part.

I need a Command Button that is really a Save button to get this into action.


For the life of me, I cannot figure out how to:
1) Save a macro, even though I can get the Sub function to run by clicking Run, I do not want everyday users of the template to do that. I need it to save as a macro so that
2) Map the macro to the Save button so they can press it to save the file as desired.

Can anyone help with the code for this? It would be greatly appreciated.

[gmayor]

You don't need a button. You can intercept the FileSave command. In an ordinary module in the template add the following. Note that a filename cannot contain "/" so use (say) a hyphen instead, as shown. As you haven't said what is in the dropdown, you need to validate the selected item for illegal filename characters again as shown.

The code assumes your dropdown is a content control list box titled VehicleDrop.

Create a new document from the template and click CTRL+S (save).

Users will have to have access to the template for the code to run.

Option Explicit

Sub FileSave()
Dim strName As String
    If ActiveDocument = ThisDocument Then
        ActiveDocument.Save
    Else
        If ActiveDocument.SelectContentControlsByTitle("VehicleDrop").Item(1).ShowingPlaceholderText = True Then
            MsgBox "Select an item from the Vehicle dropdown!"
            GoTo lbl_Exit
        Else
            strName = Format(Date, "yy-mm-dd-") & ActiveDocument.SelectContentControlsByTitle("VehicleDrop").Item(1).Range
            strName = CleanFileName(strName, "docx")
            If ActiveDocument.Name = strName Then
                ActiveDocument.Save
            Else
                On Error Resume Next
                With Dialogs(wdDialogFileSaveAs)
                    .Name = Environ("USERPROFILE") & Chr(92) & "Documents\" & strName
                    .Show
                End With
            End If
        End If
    End If
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

[JuddH99]

Wow that’s awesome. I look forward to trying this tomorrow. Thank you very much. I will let you know how it goes.

[JuddH99]

Hi, so this code works great.

I need two things added that I forgot to specify before.
In addition to the file name starting with the info from "VehicleDrop", it needs to add info to it from a date picker titled "MyDate".

Then, this needs to auto save to a folder on our server with the concatenated name. I can edit this later, but for now we will say it's "\\192.168.0.200\Test\"

Thanks again,

[JuddH99]

The date format needs to be 18-06-29

[gmayor]

What does it produce for you?
I added a hyphen after the date, but you can remove it if you wish

strName = Format(Date, "yy-mm-dd-")

You will need the Windows path of the network drive rather than the IP address to write to it with this code.

[JuddH99]

Hi Graham, this works well.

Can you add these two things to the code?

I forgot to specify before.
In addition to the file name starting with the info from "VehicleDrop", it needs to add info to it from a date picker titled "MyDate".

Then, this needs to auto save to a folder on our server with the concatenated name. I can edit this later, but for now we will say it's "\\192.168.0.200\Test\"

[JuddH99]

Hi Graham, here is the Windows path I will be using "V:\Inspections\2018". The date and final name structure look fine.

[gmayor]

You could change the section in the code to

With Dialogs(wdDialogFileSaveAs)
     .Name = "V:\Inspections\2018\" & strName
     .Show
 End With

or you could replace that with

ActiveDocument.SaveAs2 "V:\Inspections\2018\" & strName

which will save the file without displaying the dialog, but it will overwrite an existing file of the same name and will crash if the folder doesn't exist.


You will find CreateFolders and FileNameUnique code on my web site to overcome these issues.