[Calendrier Outlook] Récupération d'informations

**bitardo** · 19/06/2007, 12h30

Bonjour, je développe actuellement une macro pour outlook dans le cadre d'un stage, et j'aurais quelques questions auxquelles je n'ai pas trouvé de réponse dans les FAQ ou les autres forums (j'ai peut-être mal cherché aussi)

Est-il possible de savoir quelle est le nom de l'utilisateur qui utilise outlook à travers la macro?
Car en fait c'est une macro qui va s'exécuter sur plusieurs postes en même temps, et cette macro crée un fichier qui doit porter le nom de la personne qui a lancé la macro ( afin de savoir à qui appartient le fichier ).

J'ai une deuxième question, est-il possible de transformer la macro en service?

ou alors, est-il possible de faire en sorte qu'elle s'éxécute à des instants définis et sans action de l'utilisateur.

Merci d'avance

**Heureux-oli** · 19/06/2007, 21h53

Ce nom n'est pas propre à Outlook mais au système.

Pour y arriver, il faut le faire en deux fois c'est mieux.

Une fonction

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
 
Public Function Utilisateur() as string
Utilisateur = Environ("username")
End Function

Si tu vas dans la console, et que tu tape SET, tu va voir apparaître une foule d'informations relatives à la machine et à l'utilisateur.

Username est le nom d'utilisateur.

Ensuite, il te suffit de faire appel à cette fonction dans ton code pour récupérer le nom de l'utilisateur. C'est le nom de la session windows.

**bitardo** · 20/06/2007, 08h35

Merci beaucoup, j'avais trouvé une astuce en passant par currentuser, mais ta solution est mieux.

Sinon concernant le fait de mettre une macro en tant que service, c'est possible ou carrément pas?

Merci d'avance

**Heureux-oli** · 20/06/2007, 09h56

Mettre une macro comme service, j'ai jamais tenté la chose et à mon avis c'est peu probable.

Pour fonctionner, elle a besoin d'une application comme support.

**bitardo** · 20/06/2007, 11h19

Merci pour tes réponses en tout cas

Comme on ne peut pas la mettre en tant que service, j'aimerais qu'elle se déclenche à heures fixes, ainsi qu'au démarrage et à la fermeture d'Outlook.

Concernant le démarrage et la fermeture, aucun problème, c'est fait.

Par contre, je n'arrive pas à la déclencher à heures fixes, après avoir cherché un peu, j'ai trouvé des trucs du style Application.OnTime Timevalue("heuredelancement"),"macroalancer",True...
Par contre, ça ne marche pas du tout, outlook ne reconnait même pas OnTime...
Si vous avez une autre solution, je suis preneur.

**Heureux-oli** · 20/06/2007, 12h40

Pour le démarrage de Outlook, c'est

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
 
Sub Application_Startup()
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
 
Sub Application_Quit()
End Sub

**bitardo** · 20/06/2007, 15h14

Merci Heureux-oli pour ton attention à mon problème
Concernant application quit et application start, j'avais déjà trouvé ça, et ça fonctionne, il me reste quand même à faire le déclenchement à heures fixes, et ça ça pose problème...

Sinon j'ai un autre dernier problème.......
J'extrais les rendez-vous du calendrier outlook.
Cependant quand on crée un nouveau rendez-vous, on peut spécifier des contacts que l'on rajoute à ce rendez-vous ( en bas à gauche de la fenêtre ).
Mais je n'arrive pas à trouver la propriété qui contient la liste de ces contacts....super frustrant, j'ai testé toutes les propriétés que m'offrait Outlook.appointmentItem (qui contient la liste de tous les rendez vous du calendrier)
En gros j'arrive pas avec ma macro à récupérer les contacts que je rajoute à mon rendez-vous (pas les personnes qui doivent être présentes au rendez-vous, mais un autre type de contacts, je sais pas si je suis très clair)
Si quelqu'un sait comment récupéré ça, je suis très intéressé

**ylabarre** · 25/06/2007, 15h14

Envoyé par bitardo

Merci Heureux-oli pour ton attention à mon problème
Concernant application quit et application start, j'avais déjà trouvé ça, et ça fonctionne, il me reste quand même à faire le déclenchement à heures fixes, et ça ça pose problème...

Sinon j'ai un autre dernier problème.......
J'extrais les rendez-vous du calendrier outlook.
Cependant quand on crée un nouveau rendez-vous, on peut spécifier des contacts que l'on rajoute à ce rendez-vous ( en bas à gauche de la fenêtre ).
Mais je n'arrive pas à trouver la propriété qui contient la liste de ces contacts....super frustrant, j'ai testé toutes les propriétés que m'offrait Outlook.appointmentItem (qui contient la liste de tous les rendez vous du calendrier)
En gros j'arrive pas avec ma macro à récupérer les contacts que je rajoute à mon rendez-vous (pas les personnes qui doivent être présentes au rendez-vous, mais un autre type de contacts, je sais pas si je suis très clair)
Si quelqu'un sait comment récupéré ça, je suis très intéressé

Salut bitardo,

Je passe par la et vois que tu as fait exactement ce que je recherche

Est ce possible que tu puisses me donner le code ? En fait je suis actuellement sur un projet d'outil CRM mais n'est pas de plug-in afin de synchroniser le CRM a Outlook et ton travail me permettrai de pouvoir du moins synchroniser le calendrier !!

Merci d'avance!

**bitardo** · 25/06/2007, 17h49

Salut, en fait j'ai finalement trouvé comment faire, je posterais le code demain, parce qu'il est au boulot, et que je l'ai pas sur moi la.

**Heureux-oli** · 25/06/2007, 17h52

Envoyé par bitardo

Salut, en fait j'ai finalement trouvé comment faire, je posterais le code demain, parce qu'il est au boulot, et que je l'ai pas sur moi la.

Et alors, tu devrais l'avoir en permanence sur toi, même sur ta table de nuit !!
Je suis déçu !

**ylabarre** · 25/06/2007, 18h01

Envoyé par bitardo

Salut, en fait j'ai finalement trouvé comment faire, je posterais le code demain, parce qu'il est au boulot, et que je l'ai pas sur moi la.

Merci, c'est sympa

**bitardo** · 26/06/2007, 10h55

Heureux-oli : Faut pas abuser non plus, déjà que je me cognais la tête contre les murs la journée avec ce VBA, j'allais pas m'en filer des insomnies

.
Bon pour moi maintenant c'est fini, je re-attaque le java pour traiter les fichiers que je génère avec la macro.

ylabarre : de rien quand on peut aider c'est normal.

Voilà donc mon code, si vous avez des questions, des suggestions, je suis preneur bien évidemment.
(ha oui, faudra que je finisse de commenter le code aussi

)

ma classe rendez-vous :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Option Explicit
 
Public objet As String
Public datedebut As String
Public heuredebut As String
Public heurefin As String
Public categorie As String
Public disponibilite As Integer
Public typerdv As String
 
 
Public Sub Ecrire()
    Print #1, "<evenement>"
        Print #1, Tab; "<objet>" & objet & "</objet>"
        Print #1, Tab; "<informations>"
            Print #1, Tab; Tab; "<date>" & datedebut & "</date>"
            Print #1, Tab; Tab; "<heuredebut>" & heuredebut & "</heuredebut>"
            Print #1, Tab; Tab; "<heurefin>" & heurefin & "</heurefin>"
            Print #1, Tab; Tab; "<categorie>" & categorie & "</categorie>"
            Print #1, Tab; Tab; "<disponibilite>" & disponibilite & "</disponibilite>"
            Print #1, Tab; Tab; "<type>" & typerdv & "</type>"
        Print #1, Tab; "</informations>"
    Print #1, "</evenement>"
 
 
End Sub

mon module Exporter maintenant :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
Sub exportation()
    Dim dirLocation As String
    Dim dirLocation2 As String
    Dim Racine As String
    Dim iMois As Integer
    Dim cRendezvous As New rendezvous
 
    Racine = "S:\Developpement\"
    Dim objApplication As Outlook.Application
    Dim objNameSpace As Outlook.NameSpace
    Dim objAppointments As Outlook.MAPIFolder
    Dim objAppointment As Outlook.AppointmentItem
    Dim myAppointment As Outlook.Items
    Dim appointmentIndex As Integer
    Dim iCompteur As Integer
 
    Set objApplication = CreateObject("Outlook.Application")
    Set objNameSpace = objApplication.GetNamespace("MAPI")
    Set objAppointments = objNameSpace.GetDefaultFolder(olFolderCalendar)
    Set myAppointment = objNameSpace.GetDefaultFolder(olFolderCalendar).Items
    dirLocation = Racine & Environ("username") & "." & Format(Now, "yyyymm") & ".xml"
    dirLocation2 = Racine & Environ("username") & "." & Format(Now - (Day(Now) + 1), "yyyymm") & ".xml"
 
For iMois = 0 To 1
 
    If iMois = 0 Then
    Open dirLocation For Output As #1
    Else
    Open dirLocation2 For Output As #1
    End If
    Print #1, "<?xml version=" & Chr$(34) & "1.0" & Chr$(34) & " encoding=" & Chr$(34) & "ISO-8859-1" & Chr$(34) & "?>"
    Print #1, "<!DOCTYPE donnees SYSTEM " & Chr$(34) & "DTD/donneesXML.dtd" & Chr$(34) & ">"
    Info = Split(Environ("username"), ".")
    Print #1, "<rendez-vous nom=" & Chr$(34) & Info(1) & Chr$(34) & " prenom=" & Chr$(34) & Info(0) & Chr$(34) & ">"
 
 
    For appointmentIndex = 1 To objAppointments.Items.Count
         Set objAppointment = objAppointments.Items.Item(appointmentIndex)
         ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
         ''                             Mois en cours                                  ''
         ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
         'On cherche quels éléments appartiennent au mois en cours, et lesquelles appartiennent au mois d'avant
         If Format(objAppointment.Start, "mm") = Format(Now - iMois * (Day(Now) + 1), "mm") Or Format(objAppointment.End, "mm") = Format(Now - iMois * (Day(Now) + 1), "mm") Then
 
            ''''''''''''''''''''''''''''''''''''''''''''''''''''''
            '' Gestion du cas où une tâche dure plusieurs jours ''
            ''''''''''''''''''''''''''''''''''''''''''''''''''''''
 
            If Format(objAppointment.Start, "dd") <> Format(objAppointment.End, "dd") Then
                'Si la tâche chevauche plusieurs mois
                    If Format(objAppointment.End, "mm") <> Format(objAppointment.Start, "mm") Then
                        If Format(objAppointment.Start, "mm") = Format(Now - iMois * (Day(Now) + 1), "mm") Then
                            iCompteur = 0
                            While Format(objAppointment.Start + iCompteur, "mm") = Format(Now - iMois * (Day(Now) + 1), "mm")
                                cRendezvous.objet = objAppointment.Subject
                                cRendezvous.datedebut = Format(objAppointment.Start, "yyyymm") & Format(objAppointment.Start - iCompteur, "dd")
                                cRendezvous.heuredebut = "0800"
                                cRendezvous.heurefin = "1730"
                                If objAppointment.categories = "" Then
                                cRendezvous.categorie = "HC"
                                Else
                                cRendezvous.categorie = objAppointment.categories
                                End If
                                cRendezvous.disponibilite = objAppointment.BusyStatus
                                If objAppointment.Links.Count <> 0 Then
                                cRendezvous.typerdv = objAppointment.Links.Item(1)
                                Else
                                cRendezvous.typerdv = "HP"
                                End If
                                cRendezvous.Ecrire
                                iCompteur = iCompteur + 1
                            Wend
                        ElseIf Format(objAppointment.End, "mm") = Format(Now - iMois * (Day(Now) + 1), "mm") Then
                            iCompteur = Format(objAppointment.End, "dd")
                            While iCompteur > 0
                                cRendezvous.objet = objAppointment.Subject
                                cRendezvous.datedebut = Format(objAppointment.End, "yyyymm") & Format(objAppointment.End - iCompteur + 1, "dd")
                                cRendezvous.heuredebut = "0800"
                                cRendezvous.heurefin = "1730"
                                If objAppointment.categories = "" Then
                                cRendezvous.categorie = "HC"
                                Else
                                cRendezvous.categorie = objAppointment.categories
                                End If
                                cRendezvous.disponibilite = objAppointment.BusyStatus
                                If objAppointment.Links.Count <> 0 Then
                                cRendezvous.typerdv = objAppointment.Links.Item(1)
                                Else
                                cRendezvous.typerdv = "HP"
                                End If
                                cRendezvous.Ecrire
                                iCompteur = iCompteur - 1
                            Wend
                        End If
                    Else
 
                For iCompteur = 0 To Abs(Format(objAppointment.End, "dd") - Format(objAppointment.Start, "dd"))
                    If Format(objAppointment.Start + iCompteur, "mm") = Format(Now - iMois * (Day(Now) + 1), "mm") Or Format(objAppointment.End + iCompteur, "mm") = Format(Now - iMois * (Day(Now) + 1), "mm") Then
 
                        If iCompteur <> (Format(objAppointment.End, "dd") - Format(objAppointment.Start, "dd")) Or Format(objAppointment.End, "hhmmss") <> "000000" Then
                            cRendezvous.objet = objAppointment.Subject
                            cRendezvous.datedebut = Format(objAppointment.Start + iCompteur, "yyyymmdd")
                            cRendezvous.heuredebut = "0800"
                            cRendezvous.heurefin = "1730"
                            If objAppointment.categories = "" Then
                            cRendezvous.categorie = "HC"
                            Else
                            cRendezvous.categorie = objAppointment.categories
                            End If
                            cRendezvous.disponibilite = objAppointment.BusyStatus
                            If objAppointment.Links.Count <> 0 Then
                            cRendezvous.typerdv = objAppointment.Links.Item(1)
                            Else
                            cRendezvous.typerdv = "HP"
                            End If
                            cRendezvous.Ecrire
                        End If
                    End If
                Next
                End If
            Else
                cRendezvous.objet = objAppointment.Subject
                cRendezvous.datedebut = Format(objAppointment.Start, "yyyymmdd")
                cRendezvous.heuredebut = Format(objAppointment.Start, "hhmm")
                cRendezvous.heurefin = Format(objAppointment.End, "hhmm")
                If objAppointment.categories = "" Then
                cRendezvous.categorie = "HC"
                Else
                cRendezvous.categorie = objAppointment.categories
                End If
                cRendezvous.disponibilite = objAppointment.BusyStatus
                If objAppointment.Links.Count <> 0 Then
                cRendezvous.typerdv = objAppointment.Links.Item(1)
                Else
                cRendezvous.typerdv = "HP"
                End If
                cRendezvous.Ecrire
            End If
        End If
    Next
    Print #1, "</rendez-vous>"
    Close #1
Next
    MsgBox "Les sauvegardes on été effectuées dans  : " & dirLocation & " et " & dirLocation2
End Sub

**ylabarre** · 26/06/2007, 12h07

Encore merci

si je m'amène à l'utiliser ça va bien m'être utile.

**bitardo** · 26/06/2007, 13h59

No problemo.
Si t'as des questions relatives à ce code, et dans le mesure de mes capacités, je suis prêt à t'aider

**ylabarre** · 27/06/2007, 12h07

Code puissant, rapide et fonctionne du premier coup !! thx

Par contre il me file un bug sur cette ligne :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
'Print #1, "<rendez-vous nom=" & Chr$(34) & Info(1) & Chr$(34) & " prenom=" & Chr$(34) & Info(0) & Chr$(34) & ">"
indice n'appartient pas a la selection

Une fois que je la met en commentaire tout passe mais sinon je met
print <rendez-vous> ça me va donc bon...

et j'ai également mit le code devant s'executer au démarrage de Outlook comme ça, bingo !

Merci !!

EDIT : Bien vu pour la fonction ecrire au fait, cela permet de modifier a sa guise, ce que je vais faire vu que moi ce sera un .csv avec "," au lieu du xml.
Franchement encore merci, du bon boulot.

**bitardo** · 27/06/2007, 15h08

Ha oui je vois ton problème...
En fait, là où je bosse, on est identifié en tant que prenom.nom

Donc pour récupérer d'un côté le prénom et de l'autre le nom, je fais :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Info = Split(Environ("username"), ".")

Comme ça dans Info(0) y'a le prénom et dans Info(1) le nom...

Mais effectivement si ton nom d'utilisateur n'a pas de ".", Info(1) n'existe bien évidemment pas

, d'où le message d'erreur d'indice.

J'avais pas pensé à ce cas là, faut faire un test, ou enlever le Split et mettre directement Environ("username").

Ravi que mon code te plaise

[Calendrier Outlook] Récupération d'informations

VBA Outlook

Discussions similaires

Partager

Partager