Sub PDF_MailVB()
Dim rng As Excel.Range
Dim strMail As String
With Worksheets("Dokumente").Columns("A")
Set rng = .Find("x", , xlValues, xlWhole, xlByColumns, MatchCase:=False)
If Not rng Is Nothing Then
strMail = rng.Offset(0, 1).Value
Dim name As String
Dim datei As String
datei = "Bestätigung_Attestation_Attesto_" & Mid(Date, 1, 2) & Mid(Date, 4, 2) & Mid(Date, 9, 2) & _
"_" & Mid(Time, 1, 2) & Mid(Time, 4, 2) & Mid(Time, 7, 2) & ".pdf"
name = ActiveWorkbook.Path + "\" + datei
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
name, Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
Dim Empfänger As String, Betreff As String
Dim OutApp As Object, Mail As Object, i
Dim ClpObj As DataObject
Dim Nachricht
Empfänger = strMail
Betreff = "Angebot"
Set ClpObj = New DataObject
Set OutApp = CreateObject("Outlook.Application")
Set Nachricht = OutApp.CreateItem(0)
With Nachricht
.To = Empfänger
.Subject = Betreff
.Display
End With
Set OutApp = Nothing
Set Nachricht = Nothing
Else
MsgBox "Keine Eintrag markiert."
End If
End With
End Sub