Hallo zusammen
Bei meinem aktuellen Projekt habe ich einen VBA Code eingefügt, der einen bestimmten Bereich in der Tabelle auf Knopfdruck in eine PDF umwandelt, zu Outlook sendet, sich dabei den Betreff und die vorhande Email Adresse nimmt und im Outlook einfügt, dass ich nur noch auf senden drücken muss.
Alles funktioniert perfekt wie ich es möchte, jedoch öffnet er bei mir immer das Outlook (Classic), wir haben aber eine neuere Version, die wir täglich nutzen. Ich finde diese auch bei den installierten Apps, aber leider macht er mir die nicht auf.
Liegt der Fehler manchmal im Code?



Hier noch der Code:
Option Explicit

' === Konfiguration: Diese Zellen/Blatt an deine Datei anpassen ===
Private Const SHEET_NAME As String = "Layout" ' Leer = ActiveSheet nutzen; sonst z. B. "Bericht"
Private Const EMAIL_CELL As String = "C12" ' Zelle mit E-Mail-Adresse
Private Const SUBJECT_CELL As String = "C13" ' Zelle mit Betreff
Private Const OPEN_MAIL_FOR_REVIEW As Boolean = True ' True = E-Mail anzeigen; False = sofort senden

Public Sub DruckbereichAlsPDF_Senden()
On Error GoTo ErrHandler

Dim ws As Worksheet
If SHEET_NAME = "" Then
Set ws = ActiveSheet
Else
Set ws = ThisWorkbook.Worksheets(SHEET_NAME)
End If

' --- Eingaben aus Tabelle lesen ---
Dim recipient As String
Dim mailSubject As String

recipient = Trim(ws.Range(EMAIL_CELL).Value)
mailSubject = Trim(ws.Range(SUBJECT_CELL).Value)

If Len(recipient) = 0 Then
MsgBox "In Zelle " & EMAIL_CELL & " wurde keine E-Mail-Adresse gefunden.", vbExclamation, "Fehlende E-Mail"
Exit Sub
End If
If Len(mailSubject) = 0 Then
MsgBox "In Zelle " & SUBJECT_CELL & " wurde kein Betreff gefunden.", vbExclamation, "Fehlender Betreff"
Exit Sub
End If

' --- Druckbereich prüfen ---
Dim printArea As String
printArea = ws.PageSetup.printArea
If Len(printArea) = 0 Then
MsgBox "Es ist kein Druckbereich für das Blatt '" & ws.Name & "' definiert." & vbCrLf & _
"Bitte einen Druckbereich setzen (Seitenlayout ? Druckbereich).", vbExclamation, "Kein Druckbereich"
Exit Sub
End If

' --- PDF-Datei im Temp-Ordner erstellen ---
Dim tempPath As String, pdfName As String, pdfFullPath As String
tempPath = Environ$("TEMP")
If Right$(tempPath, 1) > "\" Then tempPath = tempPath & "\"

' Dateiname: Blattname_BenutzerDatumZeit.pdf (ohne unzulässige Zeichen)
pdfName = CleanFileName(ws.Name & "_" & Format(Now, "yyyymmdd_HHMMSS") & ".pdf")
pdfFullPath = tempPath & pdfName

' Nur den Druckbereich exportieren
ws.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=pdfFullPath, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False

' --- Outlook-Mail erstellen (Late Binding) ---
Dim olApp As Object, olMail As Object
Dim createdOutlook As Boolean

On Error Resume Next
Set olApp = GetObject(Class:="outlook.Application")
If olApp Is Nothing Then
Set olApp = CreateObject("outlook.Application")
createdOutlook = True
End If
On Error GoTo ErrHandler

If olApp Is Nothing Then
MsgBox "Outlook konnte nicht gestartet werden.", vbCritical, "Outlook-Fehler"
GoTo Cleanup
End If

' 0 = olMailItem (Late Binding, keine Enum verfügbar)
Set olMail = olApp.CreateItem(0)
With olMail
.To = recipient
.Subject = mailSubject
.Body = "Guten Tag," & vbCrLf & vbCrLf & _
"anbei der aktuelle Bericht als PDF." & vbCrLf & vbCrLf & _
"Beste Grüße" & vbCrLf & Application.UserName
.Attachments.Add pdfFullPath

If OPEN_MAIL_FOR_REVIEW Then
.Display ' E-Mail zur Prüfung anzeigen
Else
.Send ' Sofort senden
MsgBox "E-Mail wurde gesendet an: " & recipient, vbInformation, "Versendet"
End If
End With

Cleanup:
' Temporäre Datei optional löschen:
' Nur löschen, wenn nicht geöffnet. Bei .Display bleibt der Anhang bestehen – Löschen ist trotzdem ok.
On Error Resume Next
If Len(Dir$(pdfFullPath)) > 0 Then Kill pdfFullPath
On Error GoTo 0

Exit Sub

ErrHandler:
MsgBox "Fehler: " & Err.Number & " — " & Err.Description, vbCritical, "Makrofehler"
Resume Cleanup
End Sub

' Hilfsfunktion: unerlaubte Zeichen aus Dateinamen entfernen
Private Function CleanFileName(ByVal s As String) As String
Dim badChars As Variant, i As Long
badChars = Array("\", "/", ":", "*", "?", """", "", ">", "|")
For i = LBound(badChars) To UBound(badChars)
s = Replace(s, badChars(i), "_")
Next i
CleanFileName = s
End Function