14.02.2025, 13:33
Hi,
ich möchte mit VBA einen Outlook Termin erzeugen mit Einfügen eines Bereiches aus einer Tabelle.
Bei dem Makro, das ich gefunden habe, kommt die Fehlermeldung:
Laufzeitfehler 438
Objekt unterstützt diese Eigenschaft oder Methode nicht und
ist gelb markiert
Was ist da falsch?
Microsoft 365 for Business
Gruß Ralf
Dieser Code als Mail versenden funktioniert:
ich möchte mit VBA einen Outlook Termin erzeugen mit Einfügen eines Bereiches aus einer Tabelle.
Bei dem Makro, das ich gefunden habe, kommt die Fehlermeldung:
Laufzeitfehler 438
Objekt unterstützt diese Eigenschaft oder Methode nicht und
PHP-Code:
.HTMLBody = bodyText ' Verwende HTMLBody für formatierte Inhalte
Was ist da falsch?
Microsoft 365 for Business
Gruß Ralf
Sub CreateOutlookAppointmentWithDynamicTable()
Dim OutlookApp As Object
Dim OutlookAppointment As Object
Dim cell As Range
Dim bodyText As String
Dim rowText As String
Dim lastRow As Long
' Erstelle eine Instanz von Outlook
On Error Resume Next
Set OutlookApp = GetObject(class:="Outlook.Application")
If Err.Number <> 0 Then
Set OutlookApp = CreateObject(class:="Outlook.Application")
End If
On Error GoTo 0
' Bestimme die letzte belegte Zeile in Spalte AA
lastRow = ThisWorkbook.Sheets(1).Cells(ThisWorkbook.Sheets(1).Rows.Count, "AA").End(xlUp).Row
' Erstelle einen neuen Termin
Set OutlookAppointment = OutlookApp.CreateItem(1) ' 1 steht für olAppointmentItem
' Beginne mit dem HTML-Format für die Tabelle
bodyText = "<html><body><table border='1' style='border-collapse:collapse;'>"
' Füge den Zellbereich AA9 bis zur letzten belegten Zeile in Spalte AA zur Tabelle hinzu
For Each cell In Range("AA9:AC" & lastRow) ' Dynamischer Bereich bis zur letzten belegten Zeile
If cell.Column = 27 Then ' Wenn wir am Anfang einer Zeile sind (AA)
rowText = "<tr>" ' Neue Zeile beginnen
End If
rowText = rowText & "<td>" & cell.Value & "</td>" ' Zelle hinzufügen
If cell.Column = 29 Then ' Wenn wir am Ende der Spalte sind (AC)
rowText = rowText & "</tr>" ' Zeile beenden und zur nächsten Zeile übergehen
bodyText = bodyText & rowText ' Füge die Zeile zur Tabelle hinzu
End If
Next cell
bodyText = bodyText & "</table></body></html>" ' Tabelle und HTML abschließen
' Setze die Eigenschaften des Termins (Datum, Betreff usw.)
With OutlookAppointment
.Subject = "Neuer Termin"
.Start = Now + 1 ' Startzeit auf morgen setzen (kann angepasst werden)
.Duration = 60 ' Dauer in Minuten
.HTMLBody = bodyText ' Verwende HTMLBody für formatierte Inhalte
.ReminderSet = True
.ReminderMinutesBeforeStart = 15 ' Erinnerung 15 Minuten vorher
.Save ' Speichern des Termins
.Display ' Anzeige des Termins (optional)
End With
' Aufräumen
Set OutlookAppointment = Nothing
Set OutlookApp = Nothing
End SubVBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media
Code erstellt und getestet in Office 16 - mit VBAHTML 12.6.0
Dieser Code als Mail versenden funktioniert:
Sub Mail_senden()
' Sendet Mail mit integriertem Bereich als Bereich mit Signatur
Dim WSh As Worksheet, WSh1 As Worksheet, WSh2 As Worksheet
Dim sMailtext As String
Dim loLetzte As Long
Dim MailAdresse As String
With Application
'.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With
Set WSh = ThisWorkbook.Sheets("Stunden") ' Datenblatt
' Set WSh1 = ThisWorkbook.Sheets("Daten") ' Blatt mit Maildaten
' Set WSh2 = ThisWorkbook.Sheets("Tabelle1") ' Datenblatt
With WSh
MailAdresse = .Range("H11") ' E-Mail-Adresse
MailAdresse = MailAdresse & "; " & .Range("H12")
loLetzte = .Cells(.Rows.Count, 2).End(xlUp).Offset(3, 0).Row
End With
With CreateObject("Outlook.Application").CreateItem(0)
.Subject = WSh.Range("H14") ' Betreff
.To = MailAdresse ' Empfänger
.cc = WSh.Range("H12") ' CC
' sMailtext = "Liste aktueller Aufträge:¶¶"
.Getinspector.Display ' Signatur holen
.HTMLBody = "<span style='font-family:Arial;font-size:11pt;color:#000080;'><u>" _
& Replace(sMailtext, "¶", "<br>") _
& "</u></span>" & .HTMLBody
WSh.Range("A1:F" & loLetzte).Copy ' Bereich kopieren
With .Getinspector.WordEditor.Application.Selection
.Start = Len(sMailtext) + 0 ' Mit der Einfügestelle ggf. spielen + x
.Paste ' Bereich in Mail einfügen
End With
End With
With Application
'.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
.EnableEvents = True
End With
End SubVBA/HTML-CodeConverter, AddIn für Office 2002-2016 - in VBA geschrieben von Lukas Mosimann. Projektbetreuung:RMH Software & Media
Code erstellt und getestet in Office 16 - mit VBAHTML 12.6.0
![[-]](https://www.clever-excel-forum.de/images/collapse.png)