Rename docm to value from checkbox, convert to .pdf, email, delete
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
|