Importing Text from Excel to Outlook 2013 Calender

Status
Not open for further replies.

BryanG

Member
Outlook version
Outlook 2013 64 bit
Email Account
Exchange Server
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
 

Attachments

Status
Not open for further replies.
Top