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
| Option Explicit
Dim OL As Object
Sub boucle_creation_meeting()
'---------------------------------------------------------------------------------------
' Procedure : boucle_creation_meeting
' Author : Oliv
' Date : 16/06/2020
' Purpose :
'---------------------------------------------------------------------------------------
'
'on connecte OUTLOOK
If UCase(Application) = "OUTLOOK" Then
Set OL = Application
Else
Set OL = CreateObject("outlook.application")
End If
Dim item As Object
'boucle EXCEL
Dim truc As Range, durée As Integer
For Each truc In Range(Range("A2"), Range("A" & Rows.Count).End(xlUp))
'exemple avec 5 COLONNES ci-dessous
'"Objet" "Début" "Fin" "Afficher la disponibilité" (0) et "Participants obligatoires.
durée = DateDiff("n", truc.Offset(0, 1), truc.Offset(0, 2))
Call ScheduleMeeting(Sujet:=truc, Du_txtbox:=truc.Offset(0, 1), duree:=durée, Email:=truc.Offset(0, 4), chef:="", Corps:="contenu de la réunion", envoi:=False)
Next truc
End Sub
Sub ScheduleMeeting(Du_txtbox, Sujet, duree, Email, chef, Corps, envoi As Boolean)
'---------------------------------------------------------------------------------------
' Procedure : ScheduleMeeting
' Author : Oliv
' Date : 07/07/2017
' Purpose :
'---------------------------------------------------------------------------------------
'
Dim myItem As Object 'Outlook.AppointmentItem
Dim myRequiredAttendee As Object 'Outlook.Recipient
Dim myOptionalAttendee As Object 'Outlook.Recipient
Const olAppointmentItem = 1
Const olMeeting = 1
Const olRequired = 1
Const olOptional = 2
Const olResource = 3
Set myItem = OL.CreateItem(olAppointmentItem)
myItem.MeetingStatus = olMeeting
'myItem.Location = "Conference Room"
'Début de l'absence
myItem.Start = Du_txtbox
'myItem.End = Demande_Absence.Au_txtbox
'myItem.AllDayEvent = True
myItem.Subject = Sujet
myItem.Duration = duree
's'il y a plusieurs adresses séparée par un ;
If InStr(1, Email, ";") > 0 Then
Dim Dest
For Each Dest In Split(Email, ";")
Set myRequiredAttendee = myItem.Recipients.Add(Dest)
myRequiredAttendee.Type = olRequired
Next
Else
If Email Like "*@*.*" Then
Set myRequiredAttendee = myItem.Recipients.Add(Email)
myRequiredAttendee.Type = olRequired
End If
End If
If chef Like "*@*.*" Then
Set myRequiredAttendee = myItem.Recipients.Add(chef)
myRequiredAttendee.Type = olRequired
End If
'Pour ajouter des destinataires optionnels
' Set myOptionalAttendee = myItem.Recipients.Add("Tout")
' myOptionalAttendee.Type = olOptional
'Pour ajouter une ressource
' Set myResourceAttendee = myItem.Recipients.add("Conference Room B")
' myResourceAttendee.Type = olResource
myItem.Body = Corps
myItem.ReminderSet = False
myItem.ResponseRequested = False
myItem.ReplyTime = False
If envoi Then
myItem.Send
Else
myItem.Display
End If
End Sub |
Partager