Thread: [Solved] VBA Novice
View Single Post
 
Old 06-28-2018, 08:49 PM
gmayor's Avatar
gmayor gmayor is offline Windows 10 Office 2016
Expert
 
Join Date: Aug 2014
Posts: 4,144
gmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud ofgmayor has much to be proud of
Default

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.

Code:
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
__________________
Graham Mayor - MS MVP (Word) (2002-2019)
Visit my web site for more programming tips and ready made processes www.gmayor.com
Reply With Quote