VBA-Bezug auf falsches Blatt
28.06.2016 18:12:46
Manuel E.
Servus werte Mit-Excelanten.
folgender Fall:
Der angehängte Code soll einen Termin in Outlook fabrizieren. Funzt soweit auch. Problem: Egal aus welchem Blatt ich den Termin erstellen möchte, es werden immer die Daten aus Blatt 1 gezogen...Ich habe versucht im Code alles möglich an Änderungen zwecks Bezug des Blattes vorzunehmen, leider ohne Erfolg.
Vielleicht kann/mag/wird mir jemand helfen.
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 = Worksheets("Eichner").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
strStartDate = cell.Offset(0, 1).Text
strStartTime = cell.Offset(0, 2).Text
strEndDate = cell.Offset(0, 3).Text
strEndTime = cell.Offset(0, 4).Text
boolAllDay = cell.Offset(0, 5).Value
strCategory = cell.Offset(0, 6).Text
.Subject = strSubject
.ReminderSet = True
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
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
End If
End If
End With
Next
Set objOL = Nothing
MsgBox counter & " Termin(e) wurden erstellt!", vbInformation
End Sub