Option Explicit

Sub SaveAs()
'
' SaveAs Macro
'
'

Dim sName As String, aCC As ContentControl
Dim sFilename As String, sNow As String, sPath As String
Dim i As Integer
    sPath = Environ("USERPROFILE") & Chr(92) & "Desktop\"
    For Each aCC In ActiveDocument.ContentControls
        If aCC.Title = "Subject" Then
            i = i + 1
            Exit For
        End If
    Next aCC
    If i = 0 Then
        MsgBox "The 'Subject' Content Control is missing", vbCritical
        Exit Sub
    End If
    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)
            sName = Replace(sName, Chr(32), "")
        End If
        sNow = Format(Now, "dd-mm-yy_HHMMSS")
        sFilename = sName & "_" & sNow & ".docx"
        ActiveDocument.SaveAs2 FileName:=sPath & sFilename, FileFormat:=wdFormatXMLDocument
    Next aCC
    Set aCC = Nothing
End Sub