Hep Taxi !

Public Sub ConstruireReservation()
  Dim i As Integer
  Dim oRst As DAO.Recordset
  Dim oRst2 As DAO.Recordset
  Dim DateValide As Date
  Dim oQry As DAO.QueryDef
  DoCmd.SetWarnings False
  
  '----------------------------------------------------'
  'Garnir tUneReservation avec toutes les dates valides'
  '----------------------------------------------------'
      'Vidanger tUneReservation
      '------------------------
  DoCmd.RunSQL "Delete * from tUneReservation;"
      'Garnir tDatesValides pour les périodes de validation
      '----------------------------------------------------
  Set oRst = CurrentDb.OpenRecordset("SELECT  ValidDu, ValidAu FROM tHorValid " _
                                     & "WHERE tHorLignesFK=" & Me.cboLigne & ";")
  Set oQry = CurrentDb.QueryDefs("rReservationDatesFutures")
  Do While Not oRst.EOF
      If oRst("ValidAu") > Date Then
          DateValide = IIf(oRst("ValidDu") >= Date, oRst("ValidDu"), Date + 1)
          Do While DateValide <= oRst("ValidAu")
            oQry.Parameters("LaDate") = DateValide
            oQry.Parameters("Depart") = Me.cboDepart
            oQry.Parameters("Destination") = Me.cboDestination
            oQry.Execute
            DateValide = DateValide + 1
          Loop
      End If
      oRst.MoveNext
  Loop

      'Supprimer les jours de la semaine non servis
      '--------------------------------------------
         'Chercher la liste des jours non servis
  Set oRst = CurrentDb.OpenRecordset("tHorLignes", dbOpenDynaset)
  oRst.FindFirst "[tHorlignesPK] = " & Me.cboLigne
         ' faire défiler tous les jours d'une semaine pour accéder aux colonnes de tHorLignes
  Set oQry = CurrentDb.QueryDefs("rReservationJoursSemSans")
  For i = 1 To 7
    If oRst(Format(Date + i, "dddd")) = False Then
        oQry.Parameters("JoursSemSans") = Format(Date + i, "dddd")
        oQry.Execute
    End If
  Next i
     'Supprimer les jours ordinaires fériés
     '-------------------------------------
  Set oQry = CurrentDb.QueryDefs("rReservationSuppressionJF")
  oQry.Parameters("SaufFete") = oRst("SaufFete")
  oQry.Execute
     'Ajouter les dates fériées si roule tous les jours fériés
     '--------------------------------------------------------
  If oRst("TousLesFeries") = True Then
      Set oQry = CurrentDb.QueryDefs("rReservationTousJrsFeries")
      'Rechercher les périodes de validité de cette ligne
      Set oRst2 = CurrentDb.OpenRecordset("SELECT ValidDu, ValidAu FROM tHorValid WHERE tHorLignesFK=" & Me.cboLigne & ";")
      'Ajouter les dates fériées valides à venir
      Do While Not oRst2.EOF
        If Date >= oRst2("ValidDu") And Date <= oRst2("ValidAu") Then
            oQry.Parameters("ValidAu") = oRst2("ValidAu")
            oQry.Parameters("Depart") = Me.cboDepart
            oQry.Parameters("Destination") = Me.cboDestination
            oQry.Execute
        End If
        oRst2.MoveNext
      Loop
  End If
    'Supprimer les dates exclues
    '---------------------------
    'Rechercher les dates exclues de cette ligne
  Set oRst2 = CurrentDb.OpenRecordset("SELECT SaufDate FROM tHorValidSauf WHERE tHorLignesFK=" & Me.cboLigne & ";")
  Set oQry = CurrentDb.QueryDefs("rReservationSuppressionDatesExclues")
  Do While Not oRst2.EOF
    oQry.Parameters("DateExclue") = oRst2("SaufDate")
    oQry.Execute
    oRst2.MoveNext
  Loop
Sortie:
  Me.Section("Détail").Visible = True
  Me.Requery
  DoCmd.SetWarnings True
  oRst.Close
  Set oRst = Nothing
  On Error Resume Next
  oRst2.Close 's'il n'a pas été ouvert, une erreur 91 sera générée
  Set oRst2 = Nothing
End Sub

Private Sub EnvoiMailRes()
  Dim oOutlook As Outlook.Application
  Dim oMonMessage As Object
  Dim oRST 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 oOutlook = 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 oOutlook = New Outlook.Application
    bolOutLookOuvert = True 'ceci pour permettre de refermer in fine Outlook que nous avons ouvert
  End If
  On Error GoTo GestionErreur
  'Construire les composantes du message
  strDestinataire = DLookup("TaxiMail", "rMailResTaxi")
  strobjet = "Réservation "
  'Construction du détail des réservations date par date
  'Recréer tMailRes et son recordset
  DoCmd.SetWarnings False
  DoCmd.OpenQuery "rMailRes"
  DoCmd.SetWarnings True
  Set oRST = CurrentDb.OpenRecordset("tMailRes")
  oRST.MoveFirst
  Do While Not oRST.EOF
    strDetail = strDetail & oRST("ResDate") & " pour " _
            & oRST("NbrePers") & " personne(s) " & oRST("Observations") _
            & Chr(10)
    oRST.MoveNext
  Loop
  strMessage = "Bonjour," & Chr(13) & Chr(10) _
  & Chr(13) & Chr(10) _
  & "Taxi commandé : " & Chr(13) & Chr(10) _
  & DLookup("CoordTaxi", "rMailResTaxi") & Chr(13) & Chr(10) _
  & " " & Chr(13) & Chr(10) _
  & "Parcours : " & Me.cboDepart.Column(1) & " " & Format(Me.cboDepart.Column(2), "hh:mm") _
            & " => " & Me.cboDestination.Column(1) & " " & Format(Me.cboDestination.Column(2), "hh:mm") _
            & Chr(13) & Chr(10) _
  & "Circulation : " & Me.[cboLigne].Column(3) & Chr(13) & Chr(10) _
  & " " & Chr(13) & Chr(10) _
  & "Pour le client : " & Chr(13) & Chr(10) _
  & DLookup("CoordClient", "rMailResClient") & Chr(13) & Chr(10) _
  & Chr(13) & Chr(10) _
  & "Pour les dates suivantes : " & Chr(13) & Chr(10) _
  & strDetail _
  & Chr(13) & Chr(10) _
  & "Réservation enregistrée par " & Me.cboOperateur.Column(1) & Chr(13) & Chr(10) _
  & Chr(13) & Chr(10) _
  & "Bien à vous."
  'Envoi de l'e-mail
  Set oMonMessage = oOutlook.CreateItem(0) 'ouvrir une structure de message
  oMonMessage.To = strDestinataire
  oMonMessage.Subject = strobjet
  oMonMessage.Body = strMessage
  oMonMessage.Send
  Sleep 1000 'pause de 1 sec pour l'envoi
  'Libérer les variables
  Set oOutlook = Nothing
  Set oMonMessage = Nothing
  oRST.Close
  Set oRST = 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)
GestionErreur:
  Select Case Err.Number
    Case 0 ' pas d'erreur
    Case Else
      MsgBox "Erreur dans EnvoiMailRes N° " & Err.Number & " " & Err.Description
  End Select
End Sub