Microsoft Office Forums - View Single Post - Drawing Button With VBA To Rename File And Save

gmayor · 10-20-2022, 11:58 PM

For the macro to apply only to the document, move the macro to the document and redirect the button to its new location. It would probably be better to save the document with macro as a template and create new documents from the template to be saved as docx.

Sticking with what you propose I suggest the following. Note that if TEST FOLDER FOR WORD SAVE AS MACRO was actually part of the path, then that would have to exist or be created for it to work. (See the create folders function on my web site at Useful VBA Functions) I have removed it and the macro will save to the user's desktop. I have also added rudimnentary error handling.

Code:

Option Explicit

Sub SaveAs()
'
' SaveAs Macro
'
'

Dim sName As String, aCC As ContentControl, iSpacePos As Integer
Dim sFilename As String, sNow As String, sPath As String

    sPath = Environ("USERPROFILE") & Chr(92) & "Desktop\"
    For Each aCC In ActiveDocument.ContentControls
        If aCC.Title = "Subject" Then
            If aCC.ShowingPlaceholderText = True Then
                MsgBox "Complete the 'Subject' field!", vbCritical
                aCC.Range.Select
                Exit Sub
            End If
            sName = Trim(aCC.Range.Text)
        End If
        iSpacePos = InStr(sName, " ")
        If iSpacePos > 0 Then
            sName = Mid(sName, iSpacePos) & "," & Left(sName, iSpacePos)
            sName = Replace(sName, " ", "")
        End If
        sNow = Format(Now, "dd-mm-yy_HHMMSS")
        sFilename = sName & "_" & sNow & ".docm"

        ActiveDocument.SaveAs2 FileName:=sPath & sFilename, FileFormat:=wdFormatXMLDocumentMacroEnabled
    Next aCC
    Set aCC = Nothing
End Sub