Précédent   Forum des professionnels en informatique > Logiciels > Microsoft Office > Outlook > VBA Outlook
Partagez cette discussion sur d'autres réseaux sociaux : Viadeo Twitter Google Facebook Digg Delicious MySpace Yahoo
Réponse Proposer ce sujet en actualité
 
Outils de la discussion
Publicité
'
Vieux 24/11/2010, 13h30   #1
Candidat au titre de Membre du Club
 
Inscription : novembre 2010
Messages : 47
Détails du profil
Informations forums :
Inscription : novembre 2010
Messages : 47
Points : 12
Points : 12
Par défaut Choisir dates limites export agenda Outlook

Bonjour à tous,

J'essaye de créer une macro sur Outlook 2007 pour exporter mon agenda personnel dans un fichier.

J'ai un peu cherché sur internet et j'ai arrangé le code à ma sauce et voici le résultat :
Code :
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
Sub export_calendar()
    On Error Resume Next
 
    'Activer la référece Microsoft Scripting Runtime dans Outils/référence
 
    Dim objNS As Outlook.NameSpace
    Dim objAppointments As Outlook.Items, objCalendarFolder As Outlook.MAPIFolder
    Dim objAppointment As Outlook.AppointmentItem
    Dim objFS As Scripting.FileSystemObject, objOutputFile As Scripting.TextStream
 
    Set objNS = Application.GetNamespace("MAPI")
    Set objCalendarFolder = objNS.GetDefaultFolder(olFolderCalendar)
    Set objAppointments = objCalendarFolder.Items
 
    Set objFS = New Scripting.FileSystemObject
    Set objOutputFile = objFS.OpenTextFile("C:\Temp\AppointmentExport.csv", ForWriting, True)
 
    'Write header line
    objOutputFile.WriteLine """journée entière"",""début"",""fin"""
 
    For Each objAppointment In objAppointments
        objOutputFile.WriteLine """" & objAppointment.Subject & """, """ & objAppointment.Start & """, """ & objAppointment.End & """"
    Next
    objOutputFile.Close
 
    Set objNS = Nothing
    Set objAppointment = Nothing
    Set objAppointments = Nothing
    Set objCalendarFolder = Nothing
    Set objFS = Nothing
    Set objOutputFile = Nothing
End Sub
En fait je lit dans l'objet de type Outlook.Items que j'initialise à la valeur de Application.GetNamespace("MAPI").GetDefaultFolder(olFolderCalendar).Items
certaines valeurs que je sélectionne.

Jusque là tout va bien.

Maintenant je voudrais pouvoir définir une fourchette de dates entre lesquelles les rendez vous sont extrait parce que pour l'instant, ça extrait juste une partie des rendez vous mais pas tous.

Si vous avez une idée..
zenico64 est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 25/11/2010, 08h31   #2
Candidat au titre de Membre du Club
 
Inscription : novembre 2010
Messages : 47
Détails du profil
Informations forums :
Inscription : novembre 2010
Messages : 47
Points : 12
Points : 12
up
zenico64 est déconnecté   Envoyer un message privé Réponse avec citation 00
Vieux 25/11/2010, 08h57   #3
Candidat au titre de Membre du Club
 
Inscription : novembre 2010
Messages : 47
Détails du profil
Informations forums :
Inscription : novembre 2010
Messages : 47
Points : 12
Points : 12
Arf Désolé en fait ça marche... J'ai quand même rajouté une condition pour prendre le calendrier seulement sur les 3 mois à venir.
Code :
1
2
3
4
5
6
7
For Each objAppointment In objAppointments
        If DateValue(objAppointment.Start) >= Date And DateValue(objAppointment.Start) <= DateSerial(DatePart("yyyy", Now), DatePart("m", Now) + 3, DatePart("d", Now)) Then
            objOutputFile.WriteLine """" & objAppointment.AllDayEvent & """,""" & DateValue(objAppointment.Start) & """,""" & TimeValue(objAppointment.Start) & """,""" & DateValue(objAppointment.End) & """,""" & TimeValue(objAppointment.End) & """"
        ElseIf DateValue(objAppointment.Start) > DateSerial(DatePart("yyyy", Now), DatePart("m", Now) + 3, DatePart("d", Now)) Then
            Exit For
        End If
    Next
zenico64 est déconnecté   Envoyer un message privé Réponse avec citation 00
Réponse Proposer ce sujet en actualité Cette discussion est résolue.
Outils de la discussion



Fuseau horaire GMT +2. Il est actuellement 16h02.


 
 
 
 
Partenaires

Hébergement Web