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