Excel nach Outlook

Sub Excel_Control_Termin_nach_Outlook()
'E 2000
'Dim OutApp As Outlook.Application
Dim OutApp As Object, apptOutApp As Object
'Hier beginnen die Termine
Range("A2").Select
Do Until ActiveCell.Value = ""
Set OutApp = CreateObject("Outlook.Application")
Set apptOutApp = OutApp.CreateItem(1) 'olAppointmentItem)
With apptOutApp
'Datum und Uhrzeit
'Hier werden zum aktuellen Tag 7 Tage addiert
.Start = Format(Now()+7, "dd.mm.yyyy") & " 08:00"
'Alternativ werden die Termine aus der Zelle genommen
'.Start = Format(ActiveCell.Value, "dd.mm.yyyy") & " 08:00"
'Dauer. Angabe ist jeweils in ganzen Minuten zu setzen
'Termininfo
.Subject = "Rechnung: " & ActiveWorkbook.Name & " kontrollieren"
'oder der Betreff steht in der Spalte rechts von den Terminen
.Subject = ActiveCell.Offset(0,1)
'Zusätzlicher Text
.Body = ""
'ort
.Location = ""
.Duration = "5"
'Erinnerung
.ReminderMinutesBeforeStart = 10
'mit Sound :-)
.ReminderPlaySound = True
'Erinnerung wiederholen
.ReminderSet = True
'Termin speichern
.Save
End With
'Nächste Zelle auswählen
ActiveCell.Offset(1, 0).Select
'Variablen leeren,... sonst "kotzt" Outlook irgendwann mal
Set apptOutApp = Nothing
Set OutApp = Nothing
Loop
MsgBox "Termine an Outlook übertragen!"
End 

Sub
Habe diesen von:  _
http://www. _
office.gmxhome.de/_excel_outlook.htm#Termin_an_Outlook
Jetzt würde ich gerne in einer extra Spalte (Spalte F) diesen Terminen eine Farbe zuteilen kö _
nnen. Anstatt einer Farbe wäre als Option evtl. auch die Zuteilung der Status "Frei", "Mit Vorbehalt", "Beschäftigt" und "Abwesend" denkbar.
Ist das machbar?
Wäre euch wirklich sehr dankbar.
Herzliche Grüße,
Franz