Liebes Forum,
aus verschiedenen Inhalten habe Teile von VBA-Codes zusammengesucht und bin folgende Problemstellung angegangen:
Mit Excel / VBA möchte ich aus Teilen meiner Tabelle eine Mail mit individuellem Text und als Anlage einen Termin mit Daten aus dieser Excel-Tabelle erzeugen und verschicken.
„Meine“ Lösung funktioniert dubioserweise in der Office 2016 Umgebung, aber in der Office 2010 Umgebung bekomme ich immer dann eine Fehlermeldung („Die Methode“ForwardAsVcal für das Objekt ‚_AppointmentItem‘ ist fehlgeschlagen“), wenn Outlook beim Makroaufruf noch geschlossen ist. Ist Outlook vor dem Makroaufruf geöffnet, wird das Makro wohl richtig abgearbeitet.
Sub Mailing_und_Termin()
Dim rng As Range
Dim OutApp As Object
Dim OutApptmt As Object
Dim OutMail As Object
Dim olOldBody As String
Dim Beschreibung As String
Dim Beschreibung1 As String
Dim Beschreibung2 As String
Dim Beschreibung3 As String
Dim Beschreibung4 As Date
Dim Beschreibung5 As String
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set OutApp = CreateObject("Outlook.Application")
Beschreibung = Sheets("Tabelle1").Range("c1") 'FD
Beschreibung1 = Sheets("Tabelle1").Range("c2") 'Vertrags-Nr
Beschreibung2 = Sheets("Tabelle1").Range("c3") 'Vertragspartner
Beschreibung3 = Sheets("Tabelle1").Range("c4") 'Vertragsgegenstand
Beschreibung4 = Sheets("Tabelle1").Range("c5") 'T für Wvl
Beschreibung5 = Sheets("Tabelle1").Range("c6") 'Grund für Wvl
Set OutApptmt = OutApp.CreateItem(1)
With OutApptmt
.Subject = "Veränderung in den Wvl. der Vertragsdaten"
.Start = Beschreibung4
'.Start = Now + 1
'.End = DateAdd("h", 1, .Start)
.AllDayEvent = True
.Body = Beschreibung & Chr(13) & Chr(13) _
& "Vertrag-Nr.:" & String(30, " ") & Beschreibung1 & Chr(13) _
& "Vertragspartner:" & String(21, " ") & Beschreibung2 & Chr(13) _
& "Vertragsgegenstand:" & String(12, " ") & Beschreibung3 & Chr(13) _
& "Termin für Wvl.:" & String(22, " ") & Beschreibung4 & Chr(13) _
& "Grund für Wvl.:" & String(23, " ") & Beschreibung5 & Chr(13) & Chr(13) _
& String(12, " ") & "eingetragen am: " & Date
.MeetingStatus = 1 '1=olMeeting
'.RequiredAttendees = "[email protected]"
.Save
Set OutMail = .ForwardAsVcal
End With
'On Error Resume Next
With OutMail
.GetInspector.display
olOldBody = .HTMLBody
.To = "[email protected]"
.cc = ""
.bcc = ""
.Subject = "Terminveränderung im Vertragsregister des FD 30"
'.HTMLBody
.Send
End With
On Error GoTo 0
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
Set OutMail = Nothing
Set OutApp = Nothing
End Sub