hi

Struggling with this one as MS left out the .htmlbody when creating appointments.

I want to paste all cells in the range Worksheets("Confirm").Range("b6:d75").Value to the body of the appointment (hopefully with formatting)


I have the following

Public Sub CreateAppointment()
 
  Dim oApp As Outlook.Application
  Dim oNameSpace As Namespace
  Dim oItem As AppointmentItem


  On Error Resume Next
  ' check if Outlook is running
  Set oApp = GetObject("Outlook.Application")
  If Err <> 0 Then
    'if not running, start it
    Set oApp = CreateObject("Outlook.Application")
  End If
  
  Set oNameSpace = oApp.GetNamespace("MAPI")
  
  Set oItem = oApp.CreateItem(olAppointmentItem)
  
  With oItem
  
    .Subject = Worksheets("Confirm").Range("C1").Value
    .Start = Worksheets("Confirm").Range("C2").Value & Worksheets("Confirm").Range("C3").Value
    .Duration = Worksheets("Confirm").Range("C4").Value
    .Body = Worksheets("Confirm").Range("b6:d75").Value

    
    .AllDayEvent = False
    .Importance = olImportanceNormal
    .Location = "Room 101"
    .ReminderSet = True
    .ReminderMinutesBeforeStart = "10"
'    .ReminderPlaySound = True
'    .ReminderSoundFile = "C:\Windows\Media\Ding.wav"
    
    Select Case 1 ' do you want to display the entry first or save it immediately?
      Case 1
        .Display
      Case 2
        .Save
    End Select
  
  End With
    
  Set oApp = Nothing
  Set oNameSpace = Nothing
  Set oItem = Nothing
     
End Sub
I have tried Ron's HTML and that has failed.

Any ideas?

Regards

Rob