Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Outlook-Termine nach Excel | Herbers Excel-Forum


Betrifft: Outlook-Termine nach Excel von: Markus
Geschrieben am: 20.01.2010 00:34:03

Hallo,
das beiliegende Makro listet alle Termine aus Outlook vom 1.1.2010 bis zum 31.12.2011 in Excel auf.
Warum wird die erste Spalte nicht als "richtiges Datum" ausgegeben.
(Es zeigt zwar die erste Spalte mit 01.01.2010 an, aber das Format ist nicht ein echtes DatumsFeld.
Zweite Frage:
lässt sich diese ärgerliche Frage mit dem Zugriff auf die Daten von Outlook im Makro unterbinden.
Besten Dank für Antwort.
Markus

Option Explicit

Sub Read_Control_Termin_to_Excel()

Dim myR As Integer, i As Integer
Dim startDate As Date, endDate As Date, recDate As Date, extDate As Date
Dim myOlApp As Object, myOlSpace As Object, myOlFolder As Object
Dim myOlDateRange As Object, sAppoint As Object
Dim extRecurr As Object
Dim strRecurr As String
'Datum vorschlagen
Select Case Weekday(Now + 1, vbMonday)
    Case Is > 5
        recDate = Now + 3
    Case Else
        recDate = Now + 1
End Select
'Datum abfragen
startDate = "01.01.2010"
endDate = "01.01.2011"
'Deklaration
Set myOlApp = CreateObject("Outlook.Application")
Set myOlSpace = myOlApp.GetNamespace("MAPI")
Set myOlFolder = myOlSpace.GetDefaultFolder(olFolderCalendar)
'Einträge ab Zeile 2
myR = 2
'Löscht alle zellen in der aktiven Tabelle
Cells.ClearContents
Cells.Interior.ColorIndex = xlNone
Cells(1, 1) = "Termin"
Cells(1, 2) = "Dauer"
Cells(1, 3) = "Ende"
Cells(1, 4) = "Ort"
Cells(1, 5) = "Betreff"
Cells(1, 6) = "Textinfo"
Cells(1, 7) = "Privat=2"
Cells(1, 8) = "Start_Zeil"
Set myOlDateRange = myOlFolder.Items.Restrict("[Start] >= '" & startDate & "' And [End] < & '" & _
 _
 _
 endDate + 1 & "'")
For Each sAppoint In myOlDateRange
    With sAppoint
        'Termindaten eintragen
     Cells(myR, 1) = Format(.Start, "dd.mm.yyyy")
          Cells(myR, 8) = Format(.Start, "hh:mm")
        Cells(myR, 2) = Format((((1 / 24) / 60) * .Duration), "hh:mm")
        Set extRecurr = .GetRecurrencePattern
        'OlRecurrenceType sein:
        'olRecursDaily = 1
        'olRecursMonthly = 2
        'olRecursMonthNth = 3
        'olRecursWeekly = 4
        'olRecursYearly = 5
        'olRecursYearNth = 6
        Select Case extRecurr.RecurrenceType
            Case 1
                strRecurr = "Täglich für "
            Case 2
                strRecurr = "Monatlich für "
            Case 3
                strRecurr = "Monatlich jeden "
            Case 4
                strRecurr = "Wöchentlich für "
            Case 5
                strRecurr = "Jährlich für "
            Case 6
                strRecurr = "Jährlich jeden "
        End Select
        If Format(extRecurr.PatternEndDate, "dd.mm.yyyy") <> Format(DateValue("31.12.4500"), "   _
_
_
dd.mm.yyyy") Then
            Cells(myR, 3) = Format(DateValue(extRecurr.PatternEndDate), "dd.mm.yyyy")
            Cells(myR, 3).Interior.ColorIndex = 3
            Cells(myR, 7) = strRecurr & DateValue(Format(extRecurr.PatternEndDate, "dd.mm.yyyy") _
 _
 _
) - startDate + 1 & " Tage"
        Else
            Cells(myR, 3) = Format(.Start + (((1 / 24) / 60) * .Duration), "hh:mm")
        End If
        Cells(myR, 4) = .Location
        Cells(myR, 5) = .Subject
        Cells(myR, 6) = .Body
         Cells(myR, 7) = .Sensitivity
        myR = myR + 1
    End With
Next
'Variablen leeren
Set myOlApp = Nothing
Set myOlSpace = Nothing
Set myOlFolder = Nothing
MsgBox "Alle Termine eingelesen!"
End Sub

  

Betrifft: AW: Outlook-Termine nach Excel von: Josef Ehrensberger
Geschrieben am: 20.01.2010 00:39:05

Hallo Markus,

mit

Cells(myR, 1) = Format(.Start, "dd.mm.yyyy")

trägst du ja kein Datum ein ,sondern Text, probier es so.
Cells(myR, 1) = CDate(.Start)

un die Zellen entsprechend formatieren.

Gruß Sepp



  

Betrifft: AW: Outlook-Termine nach Excel von: Markus
Geschrieben am: 20.01.2010 00:57:12

Hallo Sepp,

ich Esel !!
Danke vielmal !

Gruess
Markus