Outlook hente alle aftaler i kalenderen til en fil..

ok den indrykning se da ud af H.... T....
Nå men jeg håber i kan forstå mig.
Med venlig hilsen
Morten Skovborg

Dette her giver dig en enkelt dag:

Sub ShowDaysAppointments()
    Dim myOlApp As New Outlook.Application
    Dim myAppt As AppointmentItem
    Dim myNS As NameSpace
    Dim myAppts As Items
    Dim strTheDay As String
    Dim strToday As String
    Dim strMsg As String

    ' Get the day from the user. User can enter
    ' date in nearly any format.
    strTheDay = _
        InputBox("Enter the day for which you want " _
          & "to see appointments")
    ' Specify the range.
    strToday = "[Start] >= '" & strTheDay & _
        "' and [Start] < '" & strTheDay & " 11:59 pm'"
    ' Get user's appointments from Calendar folder.
    Set myNS = myOlApp.GetNamespace("MAPI")
    Set myAppts = myNS.GetDefaultFolder(olFolderCalendar).Items
    ' Sort the collection (required by IncludeRecurrences).
    myAppts.Sort "[Start]"
    ' Make sure recurring appointments are included.
    myAppts.IncludeRecurrences = True
    ' Filter the collection to include only the day's appointments.
    Set myAppts = myAppts.Restrict(strToday)
    ' Sort it again to put recurring appointments in correct order.
    myAppts.Sort "[Start]"
    ' Loop through collection and get subject and
    ' start time of each item.
    Set myAppt = myAppts.GetFirst
    Do While TypeName(myAppt) <> "Nothing"
        strMsg = strMsg & vbLf & myAppt.Subject
        strMsg = strMsg & " at " & Format(myAppt.Start, "h:mm ampm")
        Set myAppt = myAppts.GetNext
    Loop
    ' Display the information.
    MsgBox "Your appointments for " & strTheDay & " are " _
            & vbLf & strMsg

    Set myOlApp = Nothing
    Set myAppt = Nothing
    Set myNS = Nothing
    Set myAppts = Nothing
End Sub

Så håber der kan bruges...

/Mrbarnes

Denne kode løber dem allesammen igenne, men den giver en fejl forneden som jeg bare ikke kan slippe af med. Jeg arbejder videre med det.

Private Sub Command1_Click()
    Dim item As AppointmentItem
    Dim ns As NameSpace
    Dim cal As MAPIFolder
    Dim out As Outlook.Application
    Set out = New Outlook.Application
    Set ns = out.GetNamespace("MAPI")
    Set cal = ns.GetDefaultFolder(olFolderCalendar)
    Open app.Path & "\program.ini" For Output As #1
   
   
    For Each item In cal.Items
        If item.Start >= Now Then
            Print #1, item.Subject & " " & item.Body
        End If
    Next
   
    Close #1
    Set cal = Nothing
    Set ns = Nothing
    Set out = Nothing
End Sub

Her har jeg iøvrigt sat en reference til Microsoft Outlook Library 9.0 for at få det til at virke.

VH CK

Hvis mrbarnes indrykker et svar får han hele dynen..
Det var sgu hurtigt mrbarnes jeg som troede jeg kunne nå en lille pause.
Slavepisker ((-:

Mange tak
Morten Skovborg

Så kommer der et svar...

Jeg viste bare ikke om det var lige det du skulle bruge ;-)

Pause - det er der ikke tid til det er livet for kort til... ;-)

/MrBarnes