Hep Taxi !

Application Access pour gérer des réservations de transports à la demande (TAD)

Claude Leloup

Une nouvelle fois un tutoriel pour montrer combien Access permet de réaliser des outils de gestion pratiques en peu de temps.

Dans celui-ci, nous aborderons les techniques suivantes :

- les formulaires pères/fils ;

- la recherche multicritère ;

- l'interaction d'Access et d'Outlook.

Pour réagir à ce tutoriel, un espace de discussion vous est proposé sur le forum : Commentez

- Titre : Hep Taxi !

- Auteur : Claude Leloup

- Parution : 21 juillet 2016

- Mise à jour : 20 octobre 2016

- Licence : Les sources présentées sur cette page sont libres de droits et vous pouvez les utiliser à votre convenance. Par contre, la page de présentation constitue une œuvre intellectuelle protégée par les droits d'auteur. Copyright ® 2016 Claude Leloup. Aucune reproduction, même partielle, ne peut être faite de ce site et de l'ensemble de son contenu : textes, documents, images, etc. sans l'autorisation expresse de l'auteur. Sinon vous encourez selon la loi jusqu'à trois ans de prison et jusqu'à 300 000 € de dommages et intérêts.

Sommaire

- I. Le contexte

- II. Modéliser l'offre de transports

- II-A. Première étape : le réseau

- II-A-1. Deux tables pour enregistrer ces données

- II-A-2. Un formulaire père-fils pour l'encodage

- II-B. Deuxième étape : préciser les horaires

- II-B-1. Le modèle de données s'étoffe un peu

- III. Encoder l'horaire d'une ligne : formulaire fEncoHorLigne

- III-A. À l'ouverture

- III-B. L'utilisateur choisit une ligne dans la liste déroulante

- III-C. L'utilisateur complète les données

- III-D. Quand toutes les données sont encodées

- IV. Encoder une réservation

- IV-A. À l'ouverture du formulaire : choix du client

- IV-B. Choix du trajet

- IV-C. Comptabilisation de la réservation

- V. La routine ConstruireReservation

- VI. La routine EnvoiMailRes()

- VII. Encoder une annulation

- VII-A. À l'ouverture du formulaire : choix du client

- VII-B. Quand le client est désigné

- VII-C. Comptabilisation de l'annulation

- VII-D. La routine EnvoiMailAnnul()

- VIII. Vérifier la facturation

- VIII-A. Le formulaire fVerif

- VIII-A-1. À l'ouverture

- VIII-A-2. Après ciblage

- VIII-A-3. La source : rVerif

- VIII-B. L'état eVerif

- VIII-B-1. La source

- VIII-B-2. Quelques caractéristiques

- IX. Téléchargement

- X. Remerciements

I - Le contexte

Il s'agit de mettre en place quelques formulaires pour que l'équipe du CRC (Centre de Relation Clients) puisse :

- enregistrer une demande de réservation ;

- enregistrer l'annulation éventuelle d'une réservation ;

- notifier ces réservations et annulations à la compagnie de taxis ;

- vérifier la concordance entre les réservations comptabilisées et la facturation adressée par les compagnies de taxis.

II - Modéliser l'offre de transports

II-A - Première étape : le réseau

Il se compose de lignes et chaque ligne comporte plusieurs arrêts.

Par exemple,
- la ligne : 24 FONTAINE S/ SOMME - LONGPRE LES CORPS SAINTS,

- comporte les arrêts : 1) FONTAINE S/SOMME, 2) LONG LE CATELET et 3) LONGPRE LES CORPS SAINTS.

II-A-1 - Deux tables pour enregistrer ces données

II-A-2 - Un formulaire père-fils pour l'encodage

Si la technique des formulaires pères/fils ne vous est pas familière, consultez ce tutoriel : Comment classer les données dans des tables liées et construire un formulaire père/fils.

II-B - Deuxième étape : préciser les horaires

Pour chaque ligne, il faut annoncer :

- les jours de circulation ;

- le sens (aller ou retour) ;

- l'heure de chaque arrêt.

Nous intégrons ici la notion de compagnie de taxis qui assure le service.

II-B-1 - Le modèle de données s'étoffe un peu

III - Encoder l'horaire d'une ligne : formulaire fEncoHorLigne

III-A - À l'ouverture

fEncoHorLigne se présente comme ceci :

C'est un formulaire père avec trois fils : sfEncoHorArrets, sfEncoHorValid et sfEncoHorValidSauf.
Chacun a comme source la table indiquée sur la figure ci-dessus.
À l'ouverture, ces tables sont réinitialisées.

Private Sub Form_Open(Cancel As Integer)
'Purger tEncoHorArrets,tEncoHorValid, tEncoHorValidSauf
DoCmd.SetWarnings False
DoCmd.RunSQL "Delete * From tEncoHorArrets"
DoCmd.RunSQL "Delete * From tEncoHorValid"
DoCmd.RunSQL "Delete * From tEncoHorValidSauf"
DoCmd.SetWarnings True
Me.Refresh
End Sub

Private Sub Form_Current()
Dim ctl As Control
'Réinitialiser
Me.cboLigne = ""
Me.CaSens = -1
Me.txtNumCirculation = Null
Me.cboTaxis = Null
For Each ctl In Me.Controls
If ctl.Name Like "chk*" Then ctl = -1
Next ctl
Me.Refresh
End Sub

Le formulaire va permettre à l'utilisateur de compléter ces quatre tables de transit : un clic sur provoquera ensuite le transfert vers les tables cibles (tHorLignes, tHorArrets, tHorValid et tHorValidSauf).

III-B - L'utilisateur choisit une ligne dans la liste déroulante

Private Sub cboLigne_AfterUpdate()
Dim strSQL As String
Me.Refresh

'Purger tEncoHorArrets,tEncoHorValid, tEncoHorValidSauf
DoCmd.SetWarnings False
DoCmd.RunSQL "Delete * From tEncoHorArrets"
DoCmd.RunSQL "Delete * From tEncoHorValid"
DoCmd.RunSQL "Delete * From tEncoHorValidSauf"
'Créer la structure des arrêts
DoCmd.OpenQuery "rStructureArrets"
DoCmd.SetWarnings True
Me.CTNRsfEncoHorArrets.Form.Requery
End Sub

Si l'utilisateur veut encoder un horaire pour le sens Retour, il coche le bouton radio et l'ordre des arrêts s'inverse :

Private Sub CaSens_AfterUpdate()
'ordonner le sous-formulaire
If Me.CaSens = -1 Then
Me.CTNRsfEncoHorArrets.Form.RecordSource = _
"SELECT * FROM tEncoHorArrets ORDER BY EncoSequence;"
Else
Me.CTNRsfEncoHorArrets.Form.RecordSource = _
"SELECT * FROM tEncoHorArrets ORDER BY EncoSequence DESC;"
End If
End Sub

Private Sub CaSens_AfterUpdate()
'ordonner le sous-formulaire
If Me.CaSens = -1 Then
Me.CTNRsfEncoHorArrets.Form.RecordSource = _
"SELECT * FROM tEncoHorArrets ORDER BY EncoSequence;"
Else
Me.CTNRsfEncoHorArrets.Form.RecordSource = _
"SELECT * FROM tEncoHorArrets ORDER BY EncoSequence DESC;"
End If
End Sub

III-C - L'utilisateur complète les données

III-D - Quand toutes les données sont encodées

Le clic sur le bouton déclenche le code suivant :

1. Private Sub Btjouter_Click()

2. Dim lngCle As Long

3. Dim oRst As DAO.Recordset

4. Dim oQry As DAO.QueryDef

5. Dim dHeure As Date

6. Me.Refresh

7. 'Champs obligatoires présents

8. If IsNull(Me.txtNumCirculation) + IsNull(Me.cboTaxis) <> 0 Then

9. MsgBox "Un champ obligatoire n'est pas rempli !", vbCritical

10. Exit Sub

11. End If

12. 'Vérifer que cette circulation n'est pas déjà répertoriée

13. If DCount("*", "tHorLignes", "tLignesFK = " & Me.cboLigne _

14. & " AND NumCirculation =" & Me.txtNumCirculation) <> 0 Then

15. MsgBox "Cette circulation est déjà répertoriée", vbCritical

16. Exit Sub

17. End If

18. 'Vérifier ordre chronologique des arrêts

19. Set oRst = Me.CTNRsfEncoHorArrets.Form.RecordsetClone

20. oRst.MoveFirst

21. dHeure = oRst("EncoArretHeure")

22. oRst.MoveNext

23. Do Until oRst.EOF

24. If oRst("EncoArretHeure") <= dHeure Then

25. MsgBox "Chronologie incohérente !", vbCritical

26. Exit Sub

27. End If

28. dHeure = oRst("EncoArretHeure")

29. oRst.MoveNext

30. Loop

31. 'Libérer oRst

32. oRst.Close

33. Set oRst = Nothing

34. 'Vérifier qu'au moins une période de validité est spécifiée

35. If DCount("*", "tEncoHorValid") = 0 Then

36. MsgBox "La période de validité manque !", vbCritical

37. Exit Sub

38. End If

39. 'Ajouter dans tHorLignes

40. DoCmd.SetWarnings False

41. DoCmd.OpenQuery "rAJOUTtHorLignes"

42. 'Récupérer le N° attribué à tHorLignesPK

43. lngCle = DMax("tHorLignesPK", "tHorlignes")

44. 'Ajouter dans tHorArrets

45. Set oQry = CurrentDb.QueryDefs("rAJOUTtHorArrets")

46. oQry.Parameters("Ligne") = lngCle

47. oQry.Execute

48. 'Ajouter dans tHorValid

49. Set oQry = CurrentDb.QueryDefs("rAJOUTtHorValid")

50. oQry.Parameters("Ligne") = lngCle

51. oQry.Execute

52. 'Ajouter dans tHorValidSauf

53. Set oQry = CurrentDb.QueryDefs("rAJOUTtHorValidSauf")

54. oQry.Parameters("Ligne") = lngCle

55. oQry.Execute

56. 'Libérer oQry

57. Set oQry = Nothing

59. DoCmd.SetWarnings True

60. 'Réinitialiser pour un suivant éventuel

61. Call Form_Open(0)

62. Call Form_Current

63. End Sub

Commentaires du code

7 - 38 : on vérifie que les données sont cohérentes.

41 - 55 : on reporte le contenu des tables tEncoHor* dans les tables tHor*.

IV - Encoder une réservation

IV-A - À l'ouverture du formulaire : choix du client

Private Sub Form_Open(Cancel As Integer)
Me.cboClient.SetFocus
Me.cboClient.Dropdown
End Sub

La liste des clients se déploie.

Le choix du client provoque le déploiement de la liste des lignes :

Private Sub cboClient_AfterUpdate()
Me.cboLigne.SetFocus
Me.cboLigne.Dropdown
End Sub

IV-B - Choix du trajet

Quand l'opérateur choisit une ligne, de deux choses l'une :

- soit cette ligne ne comporte que deux arrêts : le point de départ et le point de destination sont donc déterminés d'office ;

- soit la ligne comporte des arrêts intermédiaires, la liste de ceux-ci est proposée au choix, à remarquer que le terminus ne fait pas partie des départs possibles.

Quand le départ a été choisi, à nouveau de deux choses l'une :

- soit l'arrêt suivant est le terminus, c'est donc la destination ;

- soit ce n'est pas le cas et une liste contenant les arrêts suivants est proposée à l'utilisateur.

1. Private Sub cboLigne_AfterUpdate()

2. Dim oQry As DAO.QueryDef

3. 'Libérer Me.cboDepart.RowSource et cboDestination.RowSource

4. Me.cboDepart.RowSource = ""

5. Me.cboDepart = ""

6. Me.cboDestination.RowSource = ""

7. Me.cboDestination = ""

9. 'Garnir la source de CboDepart

10. DoCmd.SetWarnings False

11. DoCmd.RunSQL "Delete * From tCboDepart"

12. Set oQry = CurrentDb.QueryDefs("rReservationGarnirCboDepart")

13. oQry.Parameters("Ligne") = Me.cboLigne

14. oQry.Parameters("Sens") = Me.cboLigne.Column(2)

15. oQry.Execute

16. 'Éliminer le terminus en tant que point de départ

17. DoCmd.OpenQuery "rReservationEliminerTerminusDepart"

18. 'Affecter tCboDepart à cboDepart

19. Me.cboDepart.RowSource = "SELECT *  FROM tCboDepart ORDER BY ArretHeure;"

20. 'S'il n'y a qu'un seul élément, on l'affecte.Sinon on déploie.

21. If Me.cboDepart.ListCount > 1 Then

22. Me.cboDepart.SetFocus

23. Me.cboDepart.Dropdown

24. GoTo Sortie

25. Else

26. Me.cboDepart = Me.cboDepart.ItemData(0)

27. Call cboDepart_AfterUpdate

28. End If

29. Sortie:

30. DoCmd.SetWarnings True

31. Set oQry = Nothing

32. End Sub

34. Private Sub cboDepart_AfterUpdate()

35. 'Libérer cboDestination.RowSource

36. Me.cboDestination.RowSource = ""

37. Me.cboDestination = ""

38. DoCmd.SetWarnings False

39. 'Créer la table tCboDestination

40. DoCmd.OpenQuery "rReservationGarnirCboDestination"

41. 'Affecter tCboDestination à cboDestination

42. Me.cboDestination.RowSource = "SELECT tArretsFK, ArretNom, ArretHeure " _

43. & "FROM tCboDestination ORDER BY ArretHeure;"

44. 'S'il n'y a qu'un seul élément, on l'affecte. Sinon on déploie.

45. If Me.cboDestination.ListCount > 1 Then

46. Me.cboDestination.SetFocus

47. Me.cboDestination.Dropdown

48. GoTo Sortie

49. Else

50. Me.cboDestination = Me.cboDestination.ItemData(0)

51. Call cboDestination_AfterUpdate

52. End If

53. Sortie:

54. DoCmd.SetWarnings True

55. End Sub

57. Private Sub cboDestination_AfterUpdate()

58. 'Si les champs utiles sont remplis, construire la structure d'une réservation

59. If IsNull(Me.cboClient) + IsNull(Me.cboLigne) _

60. + IsNull(Me.cboDepart) + IsNull(Me.cboDestination) = 0 _

61. Then Call ConstruireReservation

62. Me.EtiCochez.Visible = True

63. Me.EtiNbre.Visible = True

64. Me.EtiObservations.Visible = True

65. End Sub

Commentaires du code

4 - 7 : on réinitialise les zones de liste Départ et Destination.

11 - 15 : on confectionne la liste des arrêts de la ligne en exécutant la requête paramétrée :

17 : et on élimine ensuite le terminus :

34 - 55 : cas où plusieurs points de départ étaient possibles => confection de la liste des points de destination offerts.

57 - 64 : quand la destination est aussi déterminée,

- on vérifie que les champs obligatoires sont complétés (59 - 60),

- on déclenche la Sub ConstruireReservation (61), elle est décrite au § suivant,

- on rend visibles les étiquettes pour la liste qui va s'afficher (62 - 64).

IV-C - Comptabilisation de la réservation

Quand l'opérateur a coché les dates demandées par le client, un clic sur le bouton « Comptabiliser les réservations » :
- un e-mail décrivant le détail est envoyé automatiquement à la compagnie de taxis qui opère sur la ligne ;
- la table tReservations est complétée.

1. Private Sub BtCompta_Click()

2. Dim oCtl As Control

3. Dim oQry As DAO.QueryDef

5. Me.Refresh

6. 'Vérif présence du code opérateur

7. If IsNull(Me.cboOperateur) Then

8. MsgBox "Opérateur ?", vbCritical

9. Me.cboOperateur.SetFocus

10. Me.cboOperateur.Dropdown

11. Exit Sub

12. End If

13. 'Envoi de l'e-mail de réservation

14. Call EnvoiMailRes

15. 'Enregistrement de la réservation

16. DoCmd.SetWarnings False

17. Set oQry = CurrentDb.QueryDefs("rReservationCompta")

18. oQry.Parameters("Client") = Me.cboClient

19. oQry.Parameters("Ligne") = Me.cboLigne

20. oQry.Parameters("Operateur") = Me.cboOperateur

21. oQry.Execute

22. DoCmd.SetWarnings True

23. Set oQry = Nothing

24. Me.Section("Détail").Visible = False

25. For Each oCtl In Me.Controls

26. If oCtl.Name Like "Eti*" Then oCtl.Visible = False

27. If oCtl.Name Like "Cbo*" Then oCtl = Null

28. Next oCtl

29. Me.cboClient.SetFocus

30. Me.cboClient.Dropdown

31. End Sub

Commentaires du code

14 : la routine EnvoiMailRes est décrite plus loin dans ce tutoriel.

17 - 21 : on exécute la requête rReservationCompta

24 - 30 : on remet le formulaire en forme pour la réservation suivante.

V - La routine ConstruireReservation

1. Public Sub ConstruireReservation()

2. Dim i As Integer

3. Dim oRst As DAO.Recordset

4. Dim oRst2 As DAO.Recordset

5. Dim DateValide As Date

6. Dim oQry As DAO.QueryDef

7. DoCmd.SetWarnings False

9. '----------------------------------------------------'

10. 'Garnir tUneReservation avec toutes les dates valides'

11. '----------------------------------------------------'

12. 'Vidanger tUneReservation

13. '------------------------

14. DoCmd.RunSQL "Delete * from tUneReservation;"

15. 'Garnir tDatesValides pour les périodes de validation

16. '----------------------------------------------------

17. Set oRst = CurrentDb.OpenRecordset("SELECT  ValidDu, ValidAu FROM tHorValid " _

18. & "WHERE tHorLignesFK=" & Me.cboLigne & ";")

19. Set oQry = CurrentDb.QueryDefs("rReservationDatesFutures")

20. Do While Not oRst.EOF

21. If oRst("ValidAu") > Date Then

22. DateValide = IIf(oRst("ValidDu") >= Date, oRst("ValidDu"), Date + 1)

23. Do While DateValide <= oRst("ValidAu")

24. oQry.Parameters("LaDate") = DateValide

25. oQry.Parameters("Depart") = Me.cboDepart

26. oQry.Parameters("Destination") = Me.cboDestination

27. oQry.Execute

28. DateValide = DateValide + 1

29. Loop

30. End If

31. oRst.MoveNext

32. Loop

34. 'Supprimer les jours de la semaine non servis

35. '--------------------------------------------

36. 'Chercher la liste des jours non servis

37. Set oRst = CurrentDb.OpenRecordset("tHorLignes", dbOpenDynaset)

38. oRst.FindFirst "[tHorlignesPK] = " & Me.cboLigne

39. ' faire défiler tous les jours d'une semaine pour accéder aux colonnes de tHorLignes

40. Set oQry = CurrentDb.QueryDefs("rReservationJoursSemSans")

41. For i = 1 To 7

42. If oRst(Format(Date + i, "dddd")) = False Then

43. oQry.Parameters("JoursSemSans") = Format(Date + i, "dddd")

44. oQry.Execute

45. End If

46. Next i

47. 'Supprimer les jours ordinaires fériés

48. '-------------------------------------

49. Set oQry = CurrentDb.QueryDefs("rReservationSuppressionJF")

50. oQry.Parameters("SaufFete") = oRst("SaufFete")

51. oQry.Execute

52. 'Ajouter les dates fériées si roule tous les jours fériés

53. '--------------------------------------------------------

54. If oRst("TousLesFeries") = True Then

55. Set oQry = CurrentDb.QueryDefs("rReservationTousJrsFeries")

56. 'Rechercher les périodes de validité de cette ligne

57. Set oRst2 = CurrentDb.OpenRecordset("SELECT ValidDu, ValidAu FROM tHorValid WHERE tHorLignesFK=" & Me.cboLigne & ";")

58. 'Ajouter les dates fériées valides à venir

59. Do While Not oRst2.EOF

60. If Date >= oRst2("ValidDu") And Date <= oRst2("ValidAu") Then

61. oQry.Parameters("ValidAu") = oRst2("ValidAu")

62. oQry.Parameters("Depart") = Me.cboDepart

63. oQry.Parameters("Destination") = Me.cboDestination

64. oQry.Execute

65. End If

66. oRst2.MoveNext

67. Loop

68. End If

69. 'Supprimer les dates exclues

70. '---------------------------

71. 'Rechercher les dates exclues de cette ligne

72. Set oRst2 = CurrentDb.OpenRecordset("SELECT SaufDate FROM tHorValidSauf WHERE tHorLignesFK=" & Me.cboLigne & ";")

73. Set oQry = CurrentDb.QueryDefs("rReservationSuppressionDatesExclues")

74. Do While Not oRst2.EOF

75. oQry.Parameters("DateExclue") = oRst2("SaufDate")

76. oQry.Execute

77. oRst2.MoveNext

78. Loop

79. Sortie:

80. Me.Section("Détail").Visible = True

81. Me.Requery

82. DoCmd.SetWarnings True

83. oRst.Close

84. Set oRst = Nothing

85. On Error Resume Next

86. oRst2.Close 's'il n'a pas été ouvert, une erreur 91 sera générée

87. Set oRst2 = Nothing

88. End Sub

Commentaires du code

L'idée est de procéder par étapes pour peupler la table tUneReservation.

13 : on la vidange.

18 - 31 : pour chaque période de validité, on ajoute toutes les dates encore à venir.

Chaque date sera unique, même si en cours de processus on tente d'ajouter plusieurs fois une même date (des périodes de validité qui se chevaucheraient par exemple)

33 - 45 : on supprime les dates qui correspondent aux jours non servis.

36 - 37 : on accède à la ligne de la table tHorlignes qui contient les données de la ligne en cours de traitement. Ceci pour trouver la valeur (Vrai ou Faux) affectée aux colonnes « Lundi », « Mardi », etc.

39 - 45 : on boucle sept fois sur le format d'une date quelconque (ici celle d'aujourd'hui) pour obtenir chaque jour de la semaine et sept fois exécuter la requête rReservationJoursSemSans :

46 - 50 : on élimine ici les dates des jours qui ne sont pas servis s'ils sont fériés

en exécutant la requête rReservationJF

53 - 68 : on ajoute les dates de tous les jours fériés si .

54 - 57 : si la case est cochée, on se crée un jeu d'enregistrements avec les périodes de validité de cette ligne.

59 - 68 : si aujourd'hui est situé à l'intérieur d'une période de validité, on ajoute les dates fériées encore à venir dans cette période :

69 - 78 : reste à supprimer les dates exclues éventuelles :

VI - La routine EnvoiMailRes()

1. Private Sub EnvoiMailRes()

2. Dim oOutlook As Outlook.Application

3. Dim oMonMessage As Object

4. Dim oRST As DAO.Recordset

5. Dim strobjet As String

6. Dim strDestinataire As String

7. Dim strMessage As String

8. Dim iRet As Integer

9. Dim bolOutLookOuvert As Boolean

10. Dim strDetail As String

11. 'Tentative pour récupérer une session Outlook éventuellement déjà ouverte

12. On Error Resume Next

13. 'S'il n'y a pas de session ouverte, l'instruction suivante va provoquer une erreur (N° 429)

14. Set oOutlook = GetObject(, "Outlook.Application")

15. 'Traitement de l'erreur éventuelle : nous devons ouvrir une session Outlook

16. If Err.Number = 429 Then

17. iRet = Shell("C:\Program Files (x86)\Microsoft Office\Office14\OUTLOOK.EXE", vbHide)

18. Set oOutlook = New Outlook.Application

19. bolOutLookOuvert = True 'ceci pour permettre de refermer in fine Outlook que nous avons ouvert

20. End If

21. On Error GoTo GestionErreur

22. 'Construire les composantes du message

23. strDestinataire = DLookup("TaxiMail", "rMailResTaxi")

24. strobjet = "Réservation "

25. 'Construction du détail des réservations date par date

26. 'Recréer tMailRes et son recordset

27. DoCmd.SetWarnings False

28. DoCmd.OpenQuery "rMailRes"

29. DoCmd.SetWarnings True

30. Set oRST = CurrentDb.OpenRecordset("tMailRes")

31. oRST.MoveFirst

32. Do While Not oRST.EOF

33. strDetail = strDetail & oRST("ResDate") & " pour " _

34. & oRST("NbrePers") & " personne(s) " & oRST("Observations") _

35. & Chr(10)

36. oRST.MoveNext

37. Loop

38. strMessage = "Bonjour," & Chr(13) & Chr(10) _

39. & Chr(13) & Chr(10) _

40. & "Taxi commandé : " & Chr(13) & Chr(10) _

41. & DLookup("CoordTaxi", "rMailResTaxi") & Chr(13) & Chr(10) _

42. & " " & Chr(13) & Chr(10) _

43. & "Parcours : " & Me.cboDepart.Column(1) & " " & Format(Me.cboDepart.Column(2), "hh:mm") _

44. & " => " & Me.cboDestination.Column(1) & " " & Format(Me.cboDestination.Column(2), "hh:mm") _

45. & Chr(13) & Chr(10) _

46. & "Circulation : " & Me.[cboLigne].Column(3) & Chr(13) & Chr(10) _

47. & " " & Chr(13) & Chr(10) _

48. & "Pour le client : " & Chr(13) & Chr(10) _

49. & DLookup("CoordClient", "rMailResClient") & Chr(13) & Chr(10) _

50. & Chr(13) & Chr(10) _

51. & "Pour les dates suivantes : " & Chr(13) & Chr(10) _

52. & strDetail _

53. & Chr(13) & Chr(10) _

54. & "Réservation enregistrée par " & Me.cboOperateur.Column(1) & Chr(13) & Chr(10) _

55. & Chr(13) & Chr(10) _

56. & "Bien à vous."

57. 'Envoi de l'e-mail

58. Set oMonMessage = oOutlook.CreateItem(0) 'ouvrir une structure de message

59. oMonMessage.To = strDestinataire

60. oMonMessage.Subject = strobjet

61. oMonMessage.Body = strMessage

62. oMonMessage.Send

63. Sleep 1000 'pause de 1 sec pour l'envoi

64. 'Libérer les variables

65. Set oOutlook = Nothing

66. Set oMonMessage = Nothing

67. oRST.Close

68. Set oRST = Nothing

69. 'si on a dû ouvrir une session Outlook, on la referme (sinon, on laisse la main à l'utilisateur)

70. If bolOutLookOuvert = True Then KillApp (iRet)

71. GestionErreur:

72. Select Case Err.Number

73. Case 0 ' pas d'erreur

74. Case Else

75. MsgBox "Erreur dans EnvoiMailRes N° " & Err.Number & " " & Err.Description

76. End Select

77. End Sub

Commentaires du code

11 -20 : ouverture d'une session Outlook (si nécessaire).

22 - 56 : construction du message.

26 - 37 : on construit la liste des réservations avec retour à la ligne après chaque item.

41 : pour les coordonnées du taxi : la requête rMailResTaxi

Remarquez l'insertion de Car(13) & Car(10) dans la concaténation du texte qui provoquera un retour à la ligne.

49 : idem pour les coordonnées du client.

58 - 62 : on déclenche l'envoi du message.

63 : on temporise une seconde pour laisser le temps à Outlook.

Cette instruction nécessite que la fonction Sub Sleep soit déclarée dans un module (dans notre cas mFonctions) :

Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

65 - 68 : on libère les variables.

70 : on referme Outlook, si nous avions dû ouvrir la session.

VII - Encoder une annulation

VII-A - À l'ouverture du formulaire : choix du client

Seuls les clients pour lesquels une annulation est encore possible s'affichent. Contenu de la zone de liste :

VII-B - Quand le client est désigné

Ses réservations encore à venir s'affichent :

Private Sub cboClient_AfterUpdate()
Dim sSQL As String
'Purge de tAnnulation
DoCmd.SetWarnings False
DoCmd.RunSQL " Delete * From tAnnulation;"
'Créer la table des annulations possibles
DoCmd.OpenQuery "rCreatAnnulation"
DoCmd.SetWarnings True
'Afficher
Me.EtiCochez.Visible = True
Me.EtiDepuis.Visible = True
Me.Section("Détail").Visible = True
Me.Requery
End Sub

VII-C - Comptabilisation de l'annulation

Private Sub BtEnregistrer_Click()
Me.Refresh
'Vérif présence opérateur
If IsNull(Me.cboOperateur) Then
MsgBox "Quel opérateur ?"
Me.cboOperateur.SetFocus
Me.cboOperateur.Dropdown
Exit Sub
End If
'Vérif au moins une annulation
If DCount("*", "tAnnulation", "Annul = true") = 0 Then
MsgBox "Vous n'avez coché aucun poste !"
Exit Sub
End If
'Envoyer le mail d'annulation
Call EnvoiMailAnnul
'Enregistrer dans tReservations
DoCmd.SetWarnings False
DoCmd.OpenQuery "rAnnulation"
DoCmd.SetWarnings True
'Fermer le formulaire
DoCmd.Close acForm, Me.Name
End Sub

VII-D - La routine EnvoiMailAnnul()

Private Sub EnvoiMailAnnul()
Dim objOutlook As Outlook.Application
Dim objMonMessage As Object
Dim objRST As DAO.Recordset
Dim strobjet As String
Dim strDestinataire As String
Dim strMessage As String
Dim iRet As Integer
Dim bolOutLookOuvert As Boolean
Dim strDetail As String
'Tentative pour récupérer une session Outlook éventuellement déjà ouverte
On Error Resume Next
'S'il n'y a pas de session ouverte, l'instruction suivante va provoquer une erreur (N° 429)
Set objOutlook = GetObject(, "Outlook.Application")
'Traitement de l'erreur éventuelle : nous devons ouvrir une session Outlook
If Err.Number = 429 Then
iRet = Shell("C:\Program Files (x86)\Microsoft Office\Office14\OUTLOOK.EXE", vbHide)
Set objOutlook = New Outlook.Application
bolOutLookOuvert = True 'ceci pour permettre de refermer in fine Outlook que nous avons ouvert
End If
On Error GoTo GestionErreur
'Recréer tMailAnnul
DoCmd.SetWarnings False
DoCmd.OpenQuery "rMailAnnul"
DoCmd.SetWarnings True
'Construire les composantes du message
Set objRST = CurrentDb.OpenRecordset("tMailAnnul")
objRST.MoveFirst
Do While Not objRST.EOF
strDestinataire = objRST("TaxiMail")
strobjet = "Annulation de réservation(s) "
strDetail = objRST("ResDate") & " pour " & objRST("NbrePers") & " personne(s) " & objRST("Observations") & Chr(10) & Chr(13)
strMessage = "Bonjour," & Chr(13) & Chr(10) _
& " " & Chr(13) & Chr(10) _
& "Taxi commandé : " & Chr(13) & Chr(10) _
& objRST("Taxi") & Chr(13) & Chr(10) _
& " " & Chr(13) & Chr(10) _
& "Parcours : " & objRST("Depart") & " => " & objRST("Destination") & Chr(13) & Chr(10) _
& " " & Chr(13) & Chr(10) _
& "Circulation : " & objRST("NumCircul") & Chr(13) & Chr(10) _
& " " & Chr(13) & Chr(10) _
& "Pour le client : " & Chr(13) & Chr(10) _
& objRST("Client") & Chr(13) & Chr(10) _
& " " & Chr(13) & Chr(10) _
& strDetail _
& "Annulation enregistrée par " & objRST("Operateur") & Chr(13) & Chr(10) _
& Chr(13) & Chr(10) _
& "Bien à vous."
'Envoi de l'e-mail
Set objMonMessage = objOutlook.CreateItem(0) 'ouvrir une structure de message
objMonMessage.To = strDestinataire
objMonMessage.Subject = strobjet
objMonMessage.Body = strMessage
objMonMessage.Send
Sleep 1000 'pause de 1 sec pour l'envoi
objRST.MoveNext
Loop
'Libérer les variables
Set objOutlook = Nothing
Set objMonMessage = Nothing
'si on a dû ouvrir une session Outlook, on la referme (sinon, on laisse la main à l'utilisateur)
If bolOutLookOuvert = True Then
KillApp (iRet)
End If
GestionErreur:
Select Case Err.Number
Case 0 ' pas d'erreur
Case Else
MsgBox "Erreur dans EnvoiMailAnnul N° " & Err.Number & " " & Err.Description
End Select

End Sub

Ce code est calqué sur celui de la sous-routine EnvoiMailRes() décrite plus haut.

VIII - Vérifier la facturation

Ce qui est utile pour vérifier la facturation reçue des taxis se limite à une liste des réservations non annulées, en permettant le choix :

- de la compagnie de taxis ;

- du type de tarif (Jour : départ entre 7 et 19 heures ; Nuit sinon) ;

- d'une période.

Une procédure en deux temps :

- un formulaire avec recherche multicritère pour cibler les courses ;

- un état pour structurer la sélection.

VIII-A - Le formulaire fVerif

C'est un formulaire avec recherche multicritère.

VIII-A-1 - À l'ouverture

VIII-A-2 - Après ciblage

VIII-A-3 - La source : rVerif

SELECT tTaxis.taxiNom, IIf(Format([ArretHeure],"hh")<"07","Nuit",IIf(Format([ArretHeure],"hh")>"19","Nuit",IIf([ResDate]=[DateFeriee],"Nuit",IIf(Weekday([ResDate])=1,"Nuit","Jour")))) AS Mode, [LigneNom] & "/" & [NumCirculation] AS Circulation, tReservations.ResDate, tClients.ClientNom, tReservations.NbrePers, tReservations.Observations, tJoursFeries.dateFeriee, tReservations.tHorLignesFK, tLignes.LigneNom, tHorLignes.NumCirculation, tHorArrets.ArretHeure
FROM tTaxis INNER JOIN (tLignes INNER JOIN ((tClients INNER JOIN ((tReservations INNER JOIN tHorLignes ON tReservations.tHorLignesFK = tHorLignes.tHorLignesPK) LEFT JOIN tJoursFeries ON tReservations.ResDate = tJoursFeries.dateFeriee) ON tClients.tClientsPK = tReservations.tClientsFK) INNER JOIN tHorArrets ON tHorLignes.tHorLignesPK = tHorArrets.tHorLignesFK) ON tLignes.tLignesPK = tHorLignes.tLignesFK) ON tTaxis.tTaxisPK = tHorLignes.tTaxisFK
WHERE (((tTaxis.taxiNom) Like "*" & [Formulaires]![fVerif]![FiltreTaxi] & "*") AND ((IIf(Format([ArretHeure],"hh")<"07","Nuit",IIf(Format([ArretHeure],"hh")>"19","Nuit",IIf([ResDate]=[DateFeriee],"Nuit",IIf(Weekday([ResDate])=1,"Nuit","Jour"))))) Like "*" & [Formulaires]![fVerif]![FiltreMode] & "*") AND ((tReservations.ResDate)>=IIf(IsNull([Formulaires]![fVerif]![FiltreDu]),#1/1/1900#,[Formulaires]![fVerif]![FiltreDu]) And (tReservations.ResDate)<=IIf(IsNull([Formulaires]![fVerif]![FiltreAu]),#1/1/2100#,[Formulaires]![fVerif]![FiltreAu])) AND ((tReservations.AnnulDate) Is Null) AND ((tHorArrets.Sequence)=1))
ORDER BY tTaxis.taxiNom, IIf(Format([ArretHeure],"hh")<"07","Nuit",IIf(Format([ArretHeure],"hh")>"19","Nuit",IIf([ResDate]=[DateFeriee],"Nuit",IIf(Weekday([ResDate])=1,"Nuit","Jour")))), [LigneNom] & "/" & [NumCirculation], tReservations.ResDate, tClients.ClientNom;

1. Si la technique du formulaire avec recherche multicritère ne vous est pas familière, consultez ce tutoriel : Formulaire de recherche polyvalent sur la base d'une requête enregistrée.

VIII-B - L'état eVerif

VIII-B-1 - La source

C'est la même que celle du formulaire au moment du clic sur le bouton .

VIII-B-2 - Quelques caractéristiques

IX - Téléchargement

L'application au format Access2000 peut être téléchargée à cette adresse.

X - Remerciements

Merci à jbachet qui m'a expliqué en détail les aspects métier dans cette discussion.

Merci à jlliagre pour ses remarques.

Merci à f-leb pour la correction orthographique.