Importing Text from Excel to Outlook 2013 Calender

[BryanG]

Hello,

I'm trying to Import Text from an Excel Sheet weekly to an Exchange Calender (Not my own Outlook). I have tried using the Import/Export function in Outlook but this is not reliable and too cumbersome because it won't Import to Server based Calender, only my own. So I have resorted to try out VB Script, which I find complicated. I have tried the below script but Keep getting the error "The Appointment with the Subject: xxxx in row 2 is Invalid: Missing Times". Also attached is the Sheet I am trying to Import. I think the Offsets are wrong but I can't see where so I keep changing it around to no avail. My Office 2013 is in German but I am told that doesn't make any difference with VB.

Any help would be greatly appreciated as I have spent a long time on this.


Sub createAppointments()
On Error Resume Next
Dim sheet As Worksheet, rngStart As Range, rngEnd As Range, cell As Range
Set objOL = CreateObject("Outlook.Application")
Set objCal = objOL.Session.GetDefaultFolder(9)
Set sheet = Worksheets(1)
Set rngStart = sheet.Range("A2")
Set rngEnd = rngStart.End(xlDown)
counter = 0
For Each cell In sheet.Range(rngStart, rngEnd)
Set olApp = objCal.Items.Add(1)
With olApp
strSubject = cell.Text
strTitel = cell.Offset(0, 1).Text
strDescription = cell.Offset(0, 2).Text
strStartDate = cell.Offset(0, 3).Value
strEndDate = cell.Offset(0, 4).Value
strStartTime = cell.Offset(0, 5).Value
strEndTime = cell.Offset(0, 6).Value
.Subject = strSubject
.ReminderSet = False
If strCategory <> "" Then
.Categories = strCategory
End If
If boolAllDay = True Then
.AllDayEvent = True
If IsDate(strStartDate) Then
.Start = DateValue(strStartDate)
.End = DateAdd("d", 1, DateValue(strStartDate))
.Save
counter = counter + 1
Else
MsgBox "Termin mit dem Betreff: '" & strSubject & "' in Zeile " & cell.Row & " hat ungültige oder fehlende Zeitangaben", vbExclamation
End If
Else
.AllDayEvent = False
If IsDate(strStartDate) And IsDate(strEndDate) And IsDate(strStartTime) And IsDate(strEndTime) Then

.Start = DateValue(strStartDate) & " " & TimeValue(strStartTime)
.End = DateValue(strEndDate) & " " & TimeValue(strEndTime)

.Save
counter = counter + 1

Else

MsgBox "Termin mit dem Betreff: '" & strSubject & "' in Zeile " & cell.Row & " hat ungültige oder fehlende Zeitangaben", vbExclamation
End If
End If
End With

Next
Set objOL = Nothing

MsgBox counter & " Termin(e) wurden erstellt!", vbInformation

End Sub




Thanks!
Bryan