VBS til at oprette møde i MS office

Jeg har noget der er tæt på:

I Række 1: Subject Location Start Duration Busy option Reminder    Body text Email Allday event
Så f.eks. i række 2:
Fødselsdag Kims skrivebord 11/25/2014 13:30:00    30 0 1440 Lets have a meeting noone@nowhere.com FALSE

Den kan du evt rette lidt i:

Sub AddAppointments()

  Dim myoutlook As Object ' Outlook.Application
  Dim r As Long
  Dim myapt As Object ' Outlook.AppointmentItem

  ' late bound constants
  Const olAppointmentItem = 1
  Const olBusy = 2
  Const olMeeting = 1

  ' Create the Outlook session
  Set myoutlook = CreateObject("Outlook.Application")

  ' Start at row 2
  r = 2

  Do Until Trim$(Cells(r, 1).Value) = ""
    ' Create the AppointmentItem
    Set myapt = myoutlook.CreateItem(olAppointmentItem)
    ' Set the appointment properties
    With myapt
      .Subject = Cells(r, 1).Value
      .Location = Cells(r, 2).Value
      .Start = Cells(r, 3).Value
      .Duration = Cells(r, 4).Value
      .Recipients.Add Cells(r, 8).Value
      .MeetingStatus = olMeeting
      ' not necessary if recipients are email addresses
      ' myapt.Recipients.ResolveAll
      .AllDayEvent = Cells(r, 9).Value

      ' If Busy Status is not specified, default to 2 (Busy)
      If Len(Trim$(Cells(r, 5).Value)) = 0 Then
        .BusyStatus = olBusy
      Else
        .BusyStatus = Cells(r, 5).Value
      End If

      If Cells(r, 6).Value > 0 Then
        .ReminderSet = True
        .ReminderMinutesBeforeStart = Cells(r, 6).Value
      Else
        .ReminderSet = False
      End If

      .Body = Cells(r, 7).Value
      .Save
      r = r + 1
      .Send
    End With
  Loop
End Sub