Liaison Access et Outlook

**bebert12** · 18/12/2016, 11h02

Bonjour je voudrais savoir s’il est possible de faire une liaison en Access et le calendrier Outlook ou Gmail.
Ce que je voudrais s’ait quand je rentre une date dans Access après validation et sois enregistré automatiquement dans le calendrier, si c'est possible prouver vous m’aider d’avance merci.

**User** · 18/12/2016, 12h02

Bonjour,

Il faudra le faire en VBA, un exemple dans la faq pour créer un rendez-vous :

Calendrier Outlook

Cdlt,

**bebert12** · 18/12/2016, 16h19

Envoyé par User

Bonjour,

Il faudra le faire en VBA, un exemple dans la faq pour créer un rendez-vous :

Calendrier Outlook

Cdlt,

merci.

**bebert12** · 18/12/2016, 20h36

J’ai copier le code dans le bouton de validation mais rien ne se passe, faut-il faire une manip sous Outlook merci.

**User** · 18/12/2016, 20h48

C'est un peu plus compliqué car il faut préciser les arguments de la fonction dans le code avant de la lancer, je te donne un exemple :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
14
Private bouton1_click()
Dim PCalendrier as string, PDate as string, PHeure As String, PDuree As Integer, PSubject As String, PNotes As String,  PLieu As String
 
PCalendrier="Calendrier1"
PDate ="01/01/2017"
PHeure = "15:00"
PDuree = 10
PSubject ="Rendez-vous n°1"
PNotes = "Note 1"
PLieu ="Lieu 1"
 
call CreerRendezVous(PCalendrier, PDate, PHeure , PDuree, PSubject, PNotes, PLieu)
 
end sub

Il faut aussi copier le code de la fonction en haut d'un module.

Cdlt,

**bebert12** · 19/12/2016, 19h30

Merci je vais essayer je ne suis pas sûr d’avoir tout compris merci.

**User** · 19/12/2016, 20h19

Bonsoir,

Relisez le lien de la faq.

Le 1er argument c'est le nom de votre calendrier, si ce nom est une chaîne vide, il prend celui par défaut.

Cdlt,

**bebert12** · 26/12/2016, 19h26

Bonjour J'ais essayer plein de chose mais rien ne fonctionne j’ai un message d’erreur 2147221233 j'ai fait plein de recherche sur internet mais j’ai rien trouver d’avance merci.

**User** · 26/12/2016, 19h52

Bonsoir,

Pouvez-vous déjà poster le code que vous avez écrit et me donner le nom de votre calendrier sous Outlook ?

Je vais essayer de le retravailler...

Cdlt,

**bebert12** · 26/12/2016, 20h20

Voici le non du calendrier \\bertrand196@hotmail.com, pour le code j'ai recopier celui du 2eme poste, je voulais savoir s’il fallait lier à la source de données en créant une table attachée parce que je lais fait mais ça n’a rien changer merci à vous.

**User** · 26/12/2016, 20h53

A mon avis le problème vient du calendrier qu'il ne trouve pas.

Je vous donnes le code que j'ai un peu adapté pour un de mes clients :

Le fonction CreerRendezVous :

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
 
Public Function CreerRendezVous(pCalendrier As Outlook.MAPIFolder, _
 pDate As String, _
 pHeure As String, _
 pDuree As Integer, _
 pSubject As String, _
 pNotes As String, _
 pLieu As String, _
 Optional pMinutesRappel As Integer = 0)
 
On Error GoTo Add_Err
 
Dim objAppt As Outlook.AppointmentItem
Dim myFolder As Outlook.Items
 
'Selectionne le calendrier
'Selectionne le calendrier
 
Set myFolder = pCalendrier.Items
 
Set objAppt = myFolder.Add
'Cree le rendez vous
With objAppt
 
  If pDuree > 0 Then
  .Start = pDate & " " & pHeure
  .Duration = pDuree
  Else
  .Start = pDate
  .AllDayEvent = True
  End If
  .Subject = pSubject
  .Body = pNotes
  .Location = pLieu
  'Ajoute le rappel
  If pMinutesRappel > 0 Then
    .ReminderMinutesBeforeStart = pMinutesRappel
    .ReminderSet = True
  End If
  'Sauvegarde et ferme
  .Save
  .Close (olSave)
End With
'Libération des variables.
Set objAppt = Nothing
Set myFolder = Nothing
 
Exit Function
'Gere les erreurs
Add_Err:
MsgBox "Error " & Err.Number & vbCrLf & Err.Description
End Function

Le code pour tester (bien cocher la librairie "Microsoft Outlook XX.X Object Library") :

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
Dim olApp As Outlook.Application
Dim objFolder As Outlook.MAPIFolder
Dim objSubFolder As Outlook.MAPIFolder
Dim objAppointments As Outlook.MAPIFolder
 
nCalendrier ="\\bertrand196@hotmail.com"
 
Set olApp = CreateObject("Outlook.Application")
 
    For Each objFolder In olApp.ActiveExplorer.Session.Folders.item(1).Folders ' Cherche le calendrier de même nom dans outlook.
       If (objFolder.DefaultItemType = olAppointmentItem) Then
             If (objFolder.Name = nCalendrier) Then
                Set objAppointments = objFolder
                Exit For
             End If
             For Each objSubFolder In objFolder.Folders
                If (objSubFolder.Name = nCalendrier) Then
                Set objAppointments = objSubFolder
                Exit For
                End If
             Next
       End If
    Next
 
CreerRendezVous objAppointments, "29/12/2016", "14:00", 53, "Test", "Ceci est un test", "Gare de l'Est", 5
 
Set objAppointments = Nothing
Set olApp = Nothing

Cdlt,

**bwigle** · 22/02/2017, 10h13

Bonjour,

Tout d'abord, je tiens à vous remercier pour le bout de code qui m'a beaucoup servi !

Cependant, je rencontre un problème :

J'arrive à ajouter plusieurs rendez-vous (2 voir 3 rendez-vous à la suite) sans aucun problème, mais il arrive que l'ajout de rendez-vous bug. Il va y avoir la première fenêtre pour me demander la durée, puis la seconde pour le temps de rappel. Puis normalement, un Msgbox devrait s'afficher avec (RDV ajouté) qui se lance après la libération des variables. Et là, rien !!

Savez-vous d'où pourrait venir le problème, avez-vous déjà rencontré ce cas ?

Le plus étrange, c'est que la macro fonctionne très bien, mais simplement, elle fait des caprices de temps à autre après 3, 4, rendez-vous ajoutés.
Il faut que je redémarre mon PC pour que sa marche à nouveau, car même en fermant Outlook et ACCESS, la macro ne re-fonctionne pas.

Au plaisir de vous lire ...

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
Public Function CreerRendezVous(PCalendrier As String, _
 PDate As String, _
 PHeure As String, _
 PDuree As Integer, _
 PSubject As String, _
 PNotes As String, _
 PLieu As String, _
 Optional PMinutesRappel As Integer = 0)
 
On Error GoTo Add_Err
 
Dim objOutlook As Outlook.Application
Dim objAppt As Outlook.AppointmentItem
Dim olns As Outlook.NameSpace
Dim MycalendarFolder As Outlook.MAPIFolder
Dim MyFolder As Outlook.Items
 
Set objOutlook = CreateObject("Outlook.Application")
Set olns = objOutlook.GetNamespace("MAPI")
Set MycalendarFolder = olns.GetDefaultFolder(olFolderCalendar)
'Selectionne le calendrier
'Selectionne le calendrier
If PCalendrier = "" Then
Set MyFolder = MycalendarFolder.Items
Else
Set MyFolder = MycalendarFolder.Folders(PCalendrier).Items
End If
Set objAppt = MyFolder.Add
'Cree le rendez vous
With objAppt
 
  If PDuree > 0 Then
  .Start = PDate & " " & PHeure
  .Duration = PDuree
  Else
  .Start = PDate
  .AllDayEvent = True
  End If
  .Subject = PSubject
  .Body = PNotes
  .Location = PLieu
  'Ajoute le rappel
  If PMinutesRappel > 0 Then
    .ReminderMinutesBeforeStart = PMinutesRappel
    .ReminderSet = True
  End If
  'Sauvegarde et ferme
  .Save
  .Close (olSave)
End With
'Libération des variables.
Set objAppt = Nothing
Set objOutlook = Nothing
MsgBox "Rdv ajouté!"
Exit Function
'Gere les erreurs
Add_Err:
MsgBox "Error " & Err.Number & vbCrLf & Err.Description
End Function

**User** · 22/02/2017, 17h00

Bonsoir,

Si vous exécutez plusieurs fois à la suite la procédure, mettre toutes les variables (déclarations et instances) du modèle objet Outlook, dans la procédure principale l'appelant :

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
Dim objOutlook As Outlook.Application
Dim objAppt As Outlook.AppointmentItem
Dim olns As Outlook.NameSpace
Dim MycalendarFolder As Outlook.MAPIFolder
Dim MyFolder As Outlook.Items
 
Set objOutlook = CreateObject("Outlook.Application")
Set olns = objOutlook.GetNamespace("MAPI")
Set MycalendarFolder = olns.GetDefaultFolder(olFolderCalendar)
'Selectionne le calendrier
'Selectionne le calendrier
   If PCalendrier = "" Then
      Set MyFolder = MycalendarFolder.Items
   Else
      Set MyFolder = MycalendarFolder.Folders(PCalendrier).Items
   End If
 
Set objAppt = MyFolder.Add
 
CreerRendezVous objAppt, "29/12/2016", "14:00", 53, "Test", "Ceci est un test", "Gare de l'Est", 5
 
...
 
'Libération des variables.
Set objAppt = Nothing
set MyFolder = Nothing
set MycalendarFolder = Nothing
Set olns = Nothing
Set objOutlook = Nothing

Avec la déclaration de la procédure CreerRendezVous :

Code :

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

1
2
3
4
5
6
7
8
9
10
Public Function CreerRendezVous(objAppt As Outlook.AppointmentItem, _
 PDate As String, _
 PHeure As String, _
 PDuree As Integer, _
 PSubject As String, _
 PNotes As String, _
 PLieu As String, _
 Optional PMinutesRappel As Integer = 0)
...
End Function

Cdlt,

**bwigle** · 24/02/2017, 11h27

Bonjour ,

Merci beaucoup pour votre réactivité, j'ai fais les modifications, je peux ajouter plus de rendez-vous maintenant.

J'ai donc attendu un peu pour tester le code, et pas manqué, il y a toujours un problème.

Après avoir fais plusieurs tests, il s'avère que le problème pourrait venir de ce bout de code :

Code :

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

1
2
3
4
5
6
Dim rst As DAO.Recordset
 
    Set rst = Forms("GRC").Controls("Employés Client NEW").Form.RecordsetClone
    If rst.BOF Then Exit Sub
    rst.MoveLast
    NbrEnregistrement = rst.RecordCount

J'avais rajouté ça, pour avoir le nombre d'enregistrement présent dans le sous-formulaire ("Employés Client NEW").

Du coup, j'ai simplifié par :

Code :

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

NbrEnregistrement = Forms("GRC").Controls("Employés Client NEW").Form.Recordset.RecordCount

Et maintenant, tout à l'air de fonctionner ! (L'envie de toujours tout complexifier) Haha !

Cordialement

**User** · 24/02/2017, 15h49

Tant mieux,

Pensez à clore le sujet

Liaison Access et Outlook [AC-2016]

Access

Discussions similaires

Partager

Partager