Rename docm to value from checkbox, convert to .pdf, email, delete

[Lortiz70]

I have been working on a form and have been able to get everything to work but making the code send the pdf file instead of the word file. The file name is changed with each entry, so I cannot select a specific name. Below is my code so far. Any help would be appreciated.
Private Sub CommandButton1_Click()
Dim strSup As String, strDate As String, strEName As String



strSup = ThisDocument.SelectContentControlsByTitle("MySup") (1).Range.Text
strDate = ThisDocument.SelectContentControlsByTitle("MyDate" )(1).Range.Text
strEName = ThisDocument.SelectContentControlsByTitle("MyEName ")(1).Range.Text

Dim strfilename As String


If CheckBox1 = True Then
strfilename = strEName & "_" & Format(strDate, "mmddyyyy") & "_" & "1st Warning" & "_" & ".docx"
ElseIf CheckBox2 = True Then
strfilename = strEName & "_" & Format(strDate, "mmddyyyy") & "_" & "2nd Warning" & "_" & ".docx"
ElseIf CheckBox3 = True Then
strfilename = strEName & "_" & Format(strDate, "mmddyyyy") & "_" & "3rd Warning" & "_" & ".docx"
ElseIf CheckBox4 = True Then
strfilename = strEName & "_" & Format(strDate, "mmddyyyy") & "_" & "Terminated" & "_" & ".docx"
End If

ThisDocument.SaveAs strfilename


Dim StrPath As String
Dim StrName As String
Dim StrPDFName As String

StrPath = ActiveDocument.Path 'Get document path
strfilename = ActiveDocument.Name 'Get document name
StrPDFName = StrPath + "\" + strfilename + ".pdf"

ActiveDocument.ExportAsFixedFormat OutputFileName:= _
Replace(ActiveDocument.FullName, ".docx", ".pdf"), _
ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
wdExportOptimizeForPrint, Range:=wdExportAllDocument, Item:= _
wdExportDocumentContent, IncludeDocProps:=False, KeepIRM:=True, _
CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
BitmapMissingFonts:=True, UseISO19005_1:=False

StrPath = StrPath & strText & "_" & Format(strDate, "mmddyyyy") & "_" & strDept & "_Time Off" & ".pdf"
strfilename = strText & "_" & Format(strDate, "mmddyyyy") & "_" & strDept & "_Time Off" & ".pdf"

Set oOutlookApp = GetObject(, "Outlook.Application")
If Err <> 0 Then
Set oOutlookApp = CreateObject("Outlook.Application")
End If

Set oItem = oOutlookApp.CreateItem(olMailItem)
oItem.Display
oItem.Attachments.Add strfilename

With oItem


.To = "human.resources@tmshydraulics.net"
.CC = "LFettig@tmshydraulics.net"
.Subject = "Disciplinary Action Notice"

End With


End Sub

[gmayor]

If you save the document as DOCX, which doesn't support macros, you seem to be building a rod for your back. In any case it is not clear why you are saving as DOCX. If you want a DOCX copy then you should be starting from a macro enabled template and not a document.

Outlook does not behave correctly when created from Word VBA - see http://www.rondebruin.nl/win/s1/outlook/openclose.htm for the workaround which is used in the following.

You have not declared some of the variables you have used and strText is a complete mystery.

The following should be closer to what you require:

Option Explicit

Private Sub CommandButton1_Click()
Dim oOutlookApp As Object
Dim oItem As Object
Dim olInsp As Object
Dim wdDoc As Document
Dim strSup As String, strDate As String, strEName As String
Dim StrPath As String
Dim StrName As String
Dim StrPDFName As String
Dim strfilename As String
Dim strText As String
Dim oRng As Range


    strSup = ActiveDocument.SelectContentControlsByTitle("MySup")(1).Range.Text
    strDate = ActiveDocument.SelectContentControlsByTitle("MyDate")(1).Range.Text
    strEName = ActiveDocument.SelectContentControlsByTitle("MyEName")(1).Range.Text
    strText = "some text"    'Not declared or defined in the original text
    StrPath = "C:\Path\" 'The path to save the PDF file (which should not be the template path)

    If CheckBox1 = True Then    'Radiobuttons would be better than checkboxes where only one should be checked
        strfilename = strEName & "_" & Format(strDate, "mmddyyyy") & "_" & "1st Warning" & "_" & ".pdf"
    ElseIf CheckBox2 = True Then
        strfilename = strEName & "_" & Format(strDate, "mmddyyyy") & "_" & "2nd Warning" & "_" & ".pdf"
    ElseIf CheckBox3 = True Then
        strfilename = strEName & "_" & Format(strDate, "mmddyyyy") & "_" & "3rd Warning" & "_" & ".pdf"
    ElseIf CheckBox4 = True Then
        strfilename = strEName & "_" & Format(strDate, "mmddyyyy") & "_" & "Terminated" & "_" & ".pdf"
    End If

    ActiveDocument.ExportAsFixedFormat OutputFileName:= _
                                       StrPath & strfilename, _
                                       ExportFormat:=wdExportFormatPDF, OpenAfterExport:=False, OptimizeFor:= _
                                       wdExportOptimizeForPrint, Range:=wdExportAllDocument, Item:= _
                                       wdExportDocumentContent, IncludeDocProps:=False, KeepIRM:=True, _
                                       CreateBookmarks:=wdExportCreateNoBookmarks, DocStructureTags:=True, _
                                       BitmapMissingFonts:=True, UseISO19005_1:=False

    'Where do these files come from? They appear to have no relationship with the code and therefore it is not surprising that you cannot add them.

    'StrPath = StrPath & strText & "_" & Format(strDate, "mmddyyyy") & "_" & strDept & "_Time Off" & ".pdf"
    'strfilename = strText & "_" & Format(strDate, "mmddyyyy") & "_" & strDept & "_Time Off" & ".pdf"

    Set oOutlookApp = OutlookApp() 'See http://www.rondebruin.nl/win/s1/outlook/openclose.htm

    Set oItem = oOutlookApp.CreateItem(0)

    With oItem
        .to = "human.resources@tmshydraulics.net"
        .CC = "LFettig@tmshydraulics.net"
        .Subject = "Disciplinary Action Notice"
        .Attachments.Add StrPath & strfilename
        Set olInsp = .GetInspector
        Set wdDoc = olInsp.WordEditor
        Set oRng = wdDoc.Range(0, 0)
        .Display
        oRng.Text = "Please find attached the disciplinary action notice."
    End With
    Unload Me
End Sub