Teil einer Tabelle in Outlook-Termin kopieren

[Daniel.Haering]

Hallo zusammen,

ich würde gerne aus Excel heraus per Makro einen Termin erstellen - und dabei von einem Tabellenblatt die Zellen A3 bis B30 als Tabelle im Termin darstellen.

mein Code ist aktuell dieser:

Code:

Sub TerminErstellen()
  ' Outlook-Anwendung starten
  Dim oApp As Object
  Set oApp = CreateObject("Outlook.Application")

  ' Neuen Termin erstellen
  Dim oAppointment As Object
  Set oAppointment = oApp.CreateItem(1)
 
 
    ' Zellen A7 bis C24 durchlaufen und in die Tabelle einfügen
    For Each Row In ThisWorkbook.Sheets(1).Range("A3:B30").Rows
        AppointmentBody = AppointmentBody & "<tr>"
        For Each cell In Row.Cells
            AppointmentBody = AppointmentBody & "<td>" & cell.Value & "</td>"
        Next cell
        AppointmentBody = AppointmentBody & "</tr>"
    Next Row

    AppointmentBody = AppointmentBody & "</table></body></html>"

  ' Termininformationen festlegen
  With oAppointment
    .Subject = "Termin" & Sheets("Daten für Termin").Range("B3") ' Betreff (diese Zeile funzt, macht genau was sie soll)
    '.Start = "2025-06-10 10:00" ' Startzeit (YYYY-MM-DD HH:MM)
    '.Duration = 30 ' Dauer in Minuten
    .Location = "location" ' Ort
    .Body = AppointmentBody  ' Terminbeschreibung
    .Display ' Termin im Outlook-Kalender anzeigen
  End With

  ' Empfänger hinzufügen (optional)
  ' ...

  ' Termin absenden (optional)
  ' ...

  ' Objekt freigeben
  Set oAppointment = Nothing
  Set oApp = Nothing
End Sub

Der Text der Emailist dann schönster html-Text als Fließtext - also so < / td  ><   td >
 



Dass das HTML "sein soll" erkennt Excel nicht

Was ich gerne hätte wäre so etwas:

1   a
2   b
3   c
4   d
5   e


und so weiter.


Wäre gerade für jegliche Tipps dankbar, mit suchen und auch mit ChapGPT komme ich nicht weiter.

Grüße
Daniel

[schauan]

Hallöchen,

aber unsere Suche hast Du noch nicht genutzt? Es gibt z.B. von Volti eine Lösung für range2html ...

[derHoepp]

Moin,

.Body enthält den Plaintext-body. Was du suchst ist wahrscheinlich .HTMLBody

Das und die Lösung von Volti sind übrigens genau das, was dir in deinem letzten Beitrag vor zwei Jahren gesagt wurde ;)

Viele Grüße 
derHoepp

[Daniel.Haering]

Hallo,

keine Sorge, im Forum hatte ich gesucht - aber die genannten Einträge leider nicht gefunden.


das mit .HTMLBody funktioniert leider bei Outlook Terminen nicht (bei Emails schon.....)

ich hab das jetzt so gelöst, dass ich doch keine Tabelle erstellen lasse - sondern jeweis die zwei Zellen per Excel-Formel miteinander verkette und dann eben "Fließtext" mit ständig neuer Zeile im Termineintrag darstelle:

Code:

Sub TerminErstellen()
  ' Outlook-Anwendung starten
  Dim oApp As Object
  Set oApp = CreateObject("Outlook.Application")

  ' Neuen Termin erstellen
  Dim oAppointment As Object
  Set oAppointment = oApp.CreateItem(1)   '(1) steht für einen Termin, mit (0) wirds eine Email
  

    ' Zellen F3 bis F18 durchlaufen und in die Tabelle einfügen
    For Each Row In ThisWorkbook.Sheets("Daten für Termin").Range("F3:F18").Rows   'in der Spalte F steht eben Spalte A verkettet mit Spalte C und Spalte D)
        AppointmentBody = AppointmentBody & vbCrLf
        For Each cell In Row.Cells
            AppointmentBody = AppointmentBody & cell.Value
        Next cell
        AppointmentBody = AppointmentBody
    Next Row

    AppointmentBody = AppointmentBody

  ' Termininformationen festlegen
  With oAppointment
    .Subject = "lustiger Termin" & Sheets("Daten für Termin").Range("B3") ' Betreff (diese Zeile funzt, macht genau was sie soll)
    '.Start = "2025-06-10 10:00" ' Startzeit (YYYY-MM-DD HH:MM)
    '.Duration = 30 ' Dauer in Minuten
    .Location = "Musterstadt" ' Ort
    .Body = "Basisinfos zum Versuch:" & vbCrLf & AppointmentBody  ' Terminbeschreibung
    .Display ' Termin im Outlook-Kalender anzeigen
  End With

  ' Empfänger hinzufügen (optional)
  ' ...

  ' Termin absenden (optional)
  ' ...

  ' Objekt freigeben
  Set oAppointment = Nothing
  Set oApp = Nothing
 
 
    'Damit es im Vordergrund ist
    MyAppointment.Display
End Sub

vielleicht kann es ja mal jemand brauchen.


Herzlichen Dank an die helfenden, viele Grüße
Daniel

[schauan]

Hallöchen,

die KI hat mir das gebracht - von mir stammt nur das Kopieren des Bereichs und das Save habe ich auskommentiert. Der Weg hier ist ein Umweg über den Word-Editor... Obwohl da InsertClipboardPicture... steht wird hier der Tabellenausschnitt eingefügt - man könnte selbigen natürlich auch als Bild kopieren und einfügen

Code:

Sub InsertClipboardPictureInAppointment()
    Dim objOutlook As Object
    Dim objAppointment As Object
    Dim objInspector As Object

    'Excel Range to copy
    Range("A1:B3").Copy

    ' Create Outlook Application object
    Set objOutlook = CreateObject("Outlook.Application")
    
    ' Create a new Appointment item
    Set objAppointment = objOutlook.CreateItem(1) ' 1 = olAppointmentItem
    
    ' Display the appointment to access the Inspector
    objAppointment.Display
    
    ' Get the Inspector for the appointment
    Set objInspector = objAppointment.GetInspector
    
    ' Use WordEditor to paste clipboard content
    objInspector.WordEditor.Application.Selection.Paste
    
    ' Optional: Set appointment properties
    objAppointment.Subject = "Appointment with Clipboard Image"
    objAppointment.Start = Now + 1 ' Start time: 1 day from now
    objAppointment.Duration = 60 ' Duration: 60 minutes
    
    ' Save the appointment
    ' objAppointment.Save
    
    ' Clean up
    Set objInspector = Nothing
    Set objAppointment = Nothing
    Set objOutlook = Nothing
End Sub

[Daniel.Haering]

Hallo,

es läuft leider bei mir nicht durch.

Bei der Zeile

    objInspector.WordEditor.Application.Selection.Paste


steigt das Makro leider aus.


Die Meldung hab ich mal als Screenshot angehängt.
Vielleicht weiß ja jemand, woran es liegt.

Viele Grüße
Daniel

[snb]

Reicht schon:

Code:

Sub M_snb()
  Sheet1.Range("A3:B30").CopyPicture
 
  With CreateObject("Outlook.Application").CreateItem(1)
    .Subject = "Termin"
    .Start = "2025-06-10 10:00"
    .Duration = 30
    .Location = "location"
    .Body = "Beispiel"
    .Display
    .GetInspector.WordEditor.Application.Selection.Paste
    .Close 0
  End With
End Sub

[Daniel.Haering]

Hallo SNB

das ist ja mega - kurz, effizient und es funzt!

Vielen Dank dir!

Ich hab genau das, was ich mir erhofft hatte.

viele Grüße
Daniel