Save Filename based on Text Field

[madcar86]

I have a form template that I have put a command button on to submit via email. I would also like to add to the button to save as a pdf, and to save the filename based on one of the text content controls. Is this possible?

[macropod]

Yes, and it's quite simple, using code like:

With ActiveDocument
  .SaveAs2 FileName:="C:\Users\" & Environ("Username") & "\Documents\" & _
    .SelectContentControlsByTitle("MyControl")(1).Range.Text & ".PDF", _
    FileFormat:=wdFormatPDF
End With

where 'MyControl' is your content control's title.

[madcar86]

Thanks, it worked perfectly.

What would be the code to email the pdf to a specific address?

Also is there a way to have a message pop up and say that your email has been sent?

Sorry for all the questions, I am new to VBA.

[gmayor]

To send the PDF by e-mail using the following code assumes the sender has Outlook.
I have left the code displaying the message requiring the user to send it.
You can add the command to send the message if you wish, after .Display (i.e. .Send) but retain .Display:

Sub Send_PDF_As_Attachment()
Dim oOutlookApp As Object
Dim oItem As Object
Dim olInsp As Object
Dim strFname As String
Dim wdDoc As Document
Dim oRng As Range

    With ActiveDocument
        strFname = .SaveAs2(Filename:="C:\Users\" & Environ("Username") & "\Documents\" & _
         .SelectContentControlsByTitle("MyControl")(1).Range.Text & ".PDF", _
         FileFormat:=wdFormatPDF)
    End With

    On Error Resume Next
    'Get Outlook if it's running
    Set oOutlookApp = GetObject(, "Outlook.Application")

    'Outlook wasn't running, start it from code
    If Err <> 0 Then
        Set oOutlookApp = CreateObject("Outlook.Application")
    End If
    On Error GoTo 0
    'Create a new mailitem
    Set oItem = oOutlookApp.CreateItem(0)

    With oItem
        Set olInsp = .GetInspector
        Set wdDoc = olInsp.WordEditor
        Set oRng = wdDoc.Range
        oRng.Collapse 1
        oRng.Text = "This is the message body"
        .to = "someone@somewhere.com"
        .Subject = "This is the subject"
        .BodyFormat = 2
        .Attachments.Add strFname
        .Display
    End With

    'Clean up
    Set oItem = Nothing
    Set oOutlookApp = Nothing
    Set olInsp = Nothing
    Set wdDoc = Nothing
    Set oRng = Nothing
lbl_Exit:
    Exit Sub
End Sub

[madcar86]

Thanks for the quick responds. I put the code in into VBA, but when I press the button nothing happens. If i put the "Private Sub CommandButton1_Click()" on, I get a compiling error: expected end sub. What am I missing?

I really appreciate your help.

Private Sub CommandButton1_Click()
Sub Send_PDF_As_Attachment()
Dim oOutlookApp As Object
Dim oItem As Object
Dim olInsp As Object
Dim strFname As String
Dim wdDoc As Document
Dim oRng As Range

    With ActiveDocument
        strFname = .SaveAs2(FileName:="C:\Users\" & Environ("Username") & "\Documents\" & _
         .SelectContentControlsByTitle("MyControl")(1).Range.Text & ".PDF", _
         FileFormat:=wdFormatPDF)
    End With

    On Error Resume Next
    'Get Outlook if it's running
    Set oOutlookApp = GetObject(, "Outlook.Application")

    'Outlook wasn't running, start it from code
    If Err <> 0 Then
        Set oOutlookApp = CreateObject("Outlook.Application")
    End If
    On Error GoTo 0
    'Create a new mailitem
    Set oItem = oOutlookApp.CreateItem(0)

    With oItem
        Set olInsp = .GetInspector
        Set wdDoc = olInsp.WordEditor
        Set oRng = wdDoc.Range
        oRng.Collapse 1
        oRng.Text = "This is the message body"
        .to = "someone@somewhere.com"
        .Subject = "This is the subject"
        .BodyFormat = 2
        .Attachments.Add strFname
        .Display
    End With

    'Clean up
    Set oItem = Nothing
    Set oOutlookApp = Nothing
    Set olInsp = Nothing
    Set wdDoc = Nothing
    Set oRng = Nothing
lbl_Exit:
    Exit Sub
End Sub
End Sub

[gmayor]

You have embedded a sub within a sub

Private Sub CommandButton1_Click()
Sub Send_PDF_As_Attachment()

and similarly at the end you have

End Sub
End Sub

Remove one of the End Subs

and the line

Sub Send_PDF_As_Attachment()

and provided the code is associated with the button you should be getting somewhere.

[madcar86]

I now get a error expected function or variable and it highlights saveas2. Could it be that it is an Active X button? I know this is getting annoying for you I appreciate the help.

Private Sub CommandButton1_Click()
    Dim oOutlookApp As Object
    Dim oItem As Object
    Dim olInsp As Object
    Dim strFname As String
    Dim wdDoc As Document
    Dim oRng As Range

        With ActiveDocument
            strFname = .SaveAs2(FileName:="C:\Users\" & Environ("Username") & "\Documents\" & _
             .SelectContentControlsByTitle("Title")(1).Range.Text & ".PDF", _
             FileFormat:=wdFormatPDF)
        End With
    
        On Error Resume Next
        'Get Outlook if it's running
        Set oOutlookApp = GetObject(, "Outlook.Application")
    
        'Outlook wasn't running, start it from code
        If Err <> 0 Then
            Set oOutlookApp = CreateObject("Outlook.Application")
        End If
        On Error GoTo 0
        'Create a new mailitem
        Set oItem = oOutlookApp.CreateItem(0)
    
        With oItem
            Set olInsp = .GetInspector
            Set wdDoc = olInsp.WordEditor
            Set oRng = wdDoc.Range
            oRng.Collapse 1
            oRng.Text = "This is the message body"
            .to = "someone@somewhere.com"
            .Subject = "This is the subject"
            .BodyFormat = 2
            .Attachments.Add strFname
            .Display
        End With
    
        'Clean up
        Set oItem = Nothing
        Set oOutlookApp = Nothing
        Set olInsp = Nothing
        Set wdDoc = Nothing
        Set oRng = Nothing
lbl_Exit:
        Exit Sub
End Sub

[macropod]

What does the error message say?

[gmayor]

The message says Compile Error - expected Function or Variable and highlights SaveAs2.

SaveAs2 incidentally is not available in Word 2007, but the OP says 2013 and in that version the following change doesn't produce the error.

With ActiveDocument
        strfname = "C:\Users\" & Environ("Username") & "\Documents\" & .SelectContentControlsByTitle("Title")(1).Range.Text & ".PDF"
        .SaveAs2 Filename:=strfname, FileFormat:=wdFormatPDF
End With