Sub FileSaveAs()
With Dialogs(wdDialogFileSaveAs)
.Name = ActiveDocument.ContentControls(6).Range.Text & "_" & ActiveDocument.ContentControls(2).Range.Text & "_" & ActiveDocument.ContentControls(5).Range.Text & ".docx"
If .Show = 0 Then Exit Sub
End With
Set objOL = CreateObject("Outlook.Application")
strTempPath = Environ("TEMP")
strFileNameNoExtension = Mid(ActiveDocument.Name, 1, InStrRev(ActiveDocument.Name, ".", -1, vbTextCompare) - 1)
strPDFPath = strTempPath & "\" & strFileNameNoExtension & ".pdf"
ActiveDocument.SaveAs2 FileName:=strPDFPath, FileFormat:=wdFormatPDF
Set objMail = objOL.CreateItem(0)
With objMail
Set .SendUsingAccount = .Session.Accounts.Item("uuu@xxx.de")
.cc = "xxx@xxx.de; yyy@xxx.de; zzz@xxx.de;"
.Subject = "Request"
.Importance = 2
.Body = "Blablabla."
.Attachments.Add strPDFPath
.Attachments.Add ("H:\aaa.pdf")
.Display
End With
Set objOL = Nothing
End Sub