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
Bookmarks