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
| Private Sub Commande66_Click()
Dim db As Database
Dim Rst As Dao.Recordset
Dim objOutlook As New Outlook.Application
Dim objOutlookAppt As Outlook.AppointmentItem
Dim oEmail As Outlook.MailItem
Dim HTM, HTAM, DM, DAM As Date
Dim sql As String
sql = "SELECT [date formation] FROM [dates et horaires Convention] WHERE [dates et horaires Convention]![N° Convention] = " & Me.N° & ""
Set db = CurrentDb
Set Rst = CurrentDb.OpenRecordset(sql)
While Not Rst.EOF
Set HFAM = Forms![Formulaire_Modification_Conventions].Form![SSF Dates et horaires formation]![Heure Fin AM]
Set HDAM = Forms![Formulaire_Modification_Conventions].Form![SSF Dates et horaires formation]![Heure Début AM]
Set HFM = Forms![Formulaire_Modification_Conventions].Form![SSF Dates et horaires formation]![Heure Fin Matin]
Set HDM = Forms![Formulaire_Modification_Conventions].Form![SSF Dates et horaires formation]![Heure Début Matin]
Set dte = Forms![Formulaire_Modification_Conventions].Form![SSF Dates et horaires formation]![Date Formation]
Set objOutlookAppt = objOutlook.CreateItem(olAppointmentItem)
Set oEmail = objOutlook.CreateItem(olMailItem)
With objOutlookAppt
.MeetingStatus = olMeeting
.Recipients.Add "John Doe"
If HDM = "00:00" Then
.Start = dte & " " & HDAM
.End = dte & " " & HFAM
Else
If HDAM = "00:00" Then
.Start = dte & " " & HDM
.End = dte & " " & HFM
Else
.Start = dte & " " & HDM
.End = dte & " " & HFAM
End If
End If
.Subject = Me.Formation & " " & Me.Formateur
.Body = "Test"
.ReminderSet = False
.BusyStatus = olOutOfOffice
.Display
.Save
.Send
End With
Set objOutlookAppt = Nothing
Set objOutlook = Nothing
Wend
Rst.Close
End Sub |
Partager