Monatsfeld auslesen und 1 Monat addieren

Public Sub Email_Pdf()
On Error Resume Next
Dim OutlookApp As Object
Dim OutlookMailItem As Object
Dim myAttachments As Object
Dim strPath As String
Dim Abgabe As String
Dim Monat As Date
Monat = Format(DateSerial(Year(TMP), Month(TMP) + 2, 1), "MMMM")
ActiveSheet.Range("G3") = Monat
'Monat = ActiveSheet.Range("G3")
'strPath = "C:\Users\D.Sojka\Desktop\" & ActiveSheet.Range("J1").Value & " " & ActiveSheet. _
Range("G1").Value & ".pdf"
strPath = "C:\Users\A.Harzer\Desktop\" & ActiveSheet.Range("J1").Value & " " & ActiveSheet. _
Range("G1").Value & ".pdf"
ActiveSheet.Range("E1:J58").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
strPath, OpenAfterPublish:=False
Set OutlookApp = CreateObject("outlook.application")
Set OutlookMailItem = OutlookApp.CreateItem(0)
Set myAttachments = OutlookMailItem.Attachments
With OutlookMailItem
.To = Worksheets("Datenblatt").Range("G6") & Worksheets("Datenblatt").Range("G7")
.Subject = ActiveSheet.Range("A6") & " für BV " & ActiveSheet.Range("J1") & " " & _
ActiveSheet.Range("G1")
.Body = "Hallo Herr " & ActiveSheet.Range("J5") & "," & vbCrLf & "" & vbCrLf & "ich  _
bitte um Angabe folgender Daten zwecks Monatsbewertung zum o.g. Bauvorhaben:" & vbCrLf & "" & vbCrLf & _
"1. noch nicht berechnete Leistungen inkl. der noch nicht verbauten Materialien" &  _
vbCrLf & "" & vbCrLf & "2. Vorgriffe oder berechtigte Kürzungen zu den Rechnungen" & vbCrLf & "" & vbCrLf & _
"Bitte um Rückmeldung bis spätestens zum 10." & Monat & " " & ActiveSheet.Range(" _
J3") & "." & vbCrLf & "" & vbCrLf & "Danke Dirk"
myAttachments.Add strPath
'send
.Display
End With
Set OutlookApp = Nothing
Set OutlookMailItem = Nothing
Set myAttachments = Nothing
End Sub