DOC_LIB_OUTLOOK.md

##lister_rdv## liste les RDV dans les nb_jours prochains jours filtre = par ex "Subject,Start"

Function lister_rdv(Optional ByVal filtre As String = "", Optional ByVal nb_jours As Integer = -1)

##proposeMeeting## même arguments que pour getFreeBusy mais dans time_params il faut ajouter au début "trouve-moi un créneau de 1h du 07/12/2015 au 11/12/2015 de 14h à 18h par pas de 30min"

Function proposeMeeting(ByVal participants As String, ByVal time_params As String) As Variant

##getEmail## renvoie l'adresse mail du carnet outlook global à partir du nom prénom de la personne

Public Function getEmail(ByVal nom_prenom As String) As String

##checkAvailability## dit si la liste de personnes (adresses mails séparées par un "|") est dispo entre début et fin en option, si opt est non vide, ça liste les personnes non dispo

Function checkAvailability(ByVal recipients As String, ByVal debut As Date, ByVal fin As Date, Optional ByVal opt As String = "")

LIB_OUTLOOK.vbs

' liste les RDV dans les nb_jours prochains jours
' filtre = par ex "Subject,Start"
Function lister_rdv(Optional ByVal filtre As String = "", Optional ByVal nb_jours As Integer = -1)
    Dim o As Outlook.Application
    Dim NS As Outlook.Namespace
    Dim CalendarFolder As Outlook.Folder
    Dim objOwner As Outlook.Recipient
    On Error Resume Next
    Set o = GetObject(, "Outlook.Application")
    If Err <> 0 Then
        Set o = CreateObject("Outlook.Application")
    End If
    On Error GoTo 0
    Set NS = o.GetNamespace("MAPI")
     ' get default calendar
    Set curCal = NS.GetDefaultFolder(olFolderCalendar).Items
    
    ' prepare output
    Dim res As Variant
    If filtre = "" Then
        arrFiltre = Array("Start", "End", "Subject", "Duration", "Location", "Participants")
    Else
        arrFiltre = Split(filtre, ",")
    End If
    
    ' on compte le nombre de dates à récupérer
    nbDates = 0
    For i = 1 To curCal.Count
        If curCal(i).Start >= Date Then nbDates = nbDates + 1
    Next i
    ReDim res(nbDates, UBound(arrFiltre))
    
    k = 0
    For i = 1 To curCal.Count
        Set e = curCal(i)
        'e.ConversationTopic
        'e.Recipients(1).Name
        If e.Start >= Date Then
            If filtre = "" Or InStr("," & filtre & ",", ",Start,") > 0 Then res(k, searchArr("Start", arrFiltre)) = e.Start
            If filtre = "" Or InStr("," & filtre & ",", ",End,") > 0 Then res(k, searchArr("End", arrFiltre)) = e.End
            If filtre = "" Or InStr("," & filtre & ",", ",Subject,") > 0 Then res(k, searchArr("Subject", arrFiltre)) = e.Subject
            If filtre = "" Or InStr("," & filtre & ",", ",Duration,") > 0 Then res(k, searchArr("Duration", arrFiltre)) = e.Duration
            If filtre = "" Or InStr("," & filtre & ",", ",Location,") > 0 Then res(k, searchArr("Location", arrFiltre)) = e.Location
            If filtre = "" Or InStr("," & filtre & ",", ",Participants,") > 0 Then res(k, searchArr("Participants", arrFiltre)) = e.RequiredAttendees
            k = k + 1
        End If
    Next i
    
    lister_rdv = res
End Function

Sub unittest_lister_rdv()
    res = lister_rdv("Start,Subject,RequiredAttendees")
    res2 = lister_rdv()
    res3 = lister_rdv("Participants")
End Sub

' même arguments que pour getFreeBusy
' mais dans time_params il faut ajouter au début "trouve-moi un créneau de 1h du 07/12/2015 au 11/12/2015 de 14h à 18h par pas de 30min"
Function proposeMeeting(ByVal participants As String, ByVal time_params As String) As Variant
    dispos = getFreeBusy(participants, time_params)
    dispos_val = subArray(dispos, Array("", "1:", "1:"))
    notes_dispos = sumArray(dispos_val, 1)
    
    ' on crée le pochoir pour la convolution
    pas = parseTimeParams(time_params)(5)
    creneau = RegexMatch("créneau\s+de\s+([0-9]{1,3}[hm\:][0-9]{0,3})\s+du", time_params)
    creneau = Replace(creneau, "h", ":")
    If Len(Split(creneau, ":")(0)) < 2 Then creneau = "0" & creneau
    If Right(creneau, 1) = ":" Then creneau = creneau & "00"
    creneau = creneau & ":00"
    creneau = DateDiff("n", CDate("01/01/2000 00:00:00"), CDate("01/01/2000 " & creneau))
    creneau = creneau / pas
    Dim pochoir As Variant
    ReDim pochoir(1 To 1, 1 To creneau)
    For i = 1 To creneau
        pochoir(1, i) = 1
    Next i
    ' on convolue
    notes_creneaux = convolArray(notes_dispos, pochoir)
    ' on écrit les dates/heures de début de chaque créneau
    Dim finalNotes As Variant
    ReDim finalNotes(0 To 1, LBound(notes_creneaux, 2) To UBound(notes_creneaux, 2))
    For i = LBound(notes_creneaux, 2) To UBound(notes_creneaux, 2)
        finalNotes(0, i) = dispos(0, i)
        finalNotes(1, i) = notes_creneaux(1, i)
    Next i
    
    proposeMeeting = transposeArr(finalNotes)
End Function

Sub unittest_proposeMeeting()
    res = proposeMeeting("pierre.clapier@loreal.com|cyril.haziza@loreal.com", "créneau de 1h30 du 02/11/2015 au 06/11/2015 de 14h00 à 16h30 par pas de 30min")
End Sub

' renvoie un tableau avec les dispos des participants sur la période définie par time_params
' participants = "carlo.bauge@loreal.com|pierre.clapier@loreal.com"
' time_params = "du 31/01/2015 au 10/02/2015 de 14h30 à 18h par pas de 30min"
' c'est du 31/01/2015 au 10/02/2015 inclus
' le pas peut être en heures ou minutes, on peut écrire les heures en mode 14h30 ou 14:30 ou 14h
Function getFreeBusy(ByVal participants As String, ByVal time_params As String) As Variant
    ' on initialise outlook
    Dim o As Outlook.Application
    Dim NS As Outlook.Namespace
    On Error Resume Next
    Set o = GetObject(, "Outlook.Application")
    If Err <> 0 Then
        Set o = CreateObject("Outlook.Application")
    End If
    On Error GoTo 0
    Set NS = o.GetNamespace("MAPI")

    ' on récupère les paramètres de temps
    Set params = parseTimeParams(time_params)
    Dim date_dep, date_fin As Date
    date_dep = params(1)
    date_fin = params(2)
    nbDays = DateDiff("d", date_dep, date_fin) + 1
    time_dep = params(3)
    time_fin = params(4)
    pas = params(5)
    nbSlots = DateDiff("n", CDate("01/01/2000 " & time_dep), CDate("01/01/2000 " & time_fin))
    nbSlots = nbSlots / pas + 1
    
    Dim res As Variant
    persons = Split(participants, "|")
    ReDim res(0 To UBound(persons) + 1, 1 To nbSlots * nbDays) ' au lieu de 0 to 1 ce sera 0 to nbParticipants
    
    ' for each participant
    For j = 0 To UBound(persons)
        On Error GoTo nextone
        Set objRecipient = NS.CreateRecipient(persons(j))
        strFreeBusyData = objRecipient.FreeBusy(date_dep, pas)
        On Error GoTo 0
        nbSlotsInDay = 24 * 60 / pas
        slot_dep = DateDiff("n", CDate("01/01/2000 00:00:00"), CDate("01/01/2000 " & time_dep)) / pas
        slot_fin = DateDiff("n", CDate("01/01/2000 00:00:00"), CDate("01/01/2000 " & time_fin)) / pas + 1
        k = 1
        For i = 1 To nbDays
            daySlots = Mid(strFreeBusyData, (i - 1) * nbSlotsInDay + 1, nbSlotsInDay + 2)
            For p = 0 To nbSlotsInDay - 1
                If p > slot_dep And p <= slot_fin Then
                    curr_date = DateAdd("d", i - 1, date_dep)
                    curr_date = DateAdd("n", (p - 1) * pas, curr_date)
                    res(0, k) = Format(curr_date, "dd-mmm hh:mm")
                    res(j + 1, k) = Mid(daySlots, p, 1)
                    k = k + 1
                End If
            Next p
        Next i
nextone:
    Next j
    
    getFreeBusy = res
End Function

Sub unittest_getFreeBusy()
    res = getFreeBusy("pierre.clapier@loreal.com|cyril.haziza@loreal.com", "du 02/11/2015 au 06/11/2015 de 14h00 à 16h30 par pas de 30min")
End Sub

Function parseTimeParams(ByVal time_params As String) As Collection
    Dim res As New Collection
    regex_date = "[0-9]{2}/[0-9]{2}/[0-9]{4}"
    regex_time = "[0-9]{1,2}[h\:][0-9]{0,2}"
    myDates = Split(RegexMatch(regex_date, time_params, ";"), ";")
    res.Add CDate(myDates(0))
    res.Add CDate(myDates(1))
    
    Dim mytime(1) As Variant
    mytime(0) = RegexMatch("de\s+(" & regex_time & ")\s+à", time_params, ";")
    mytime(1) = RegexMatch("à\s+(" & regex_time & ")\s+par", time_params, ";")
    For i = 0 To UBound(mytime)
        mytime(i) = Replace(mytime(i), "h", ":")
        If Len(Split(mytime(i), ":")(0)) < 2 Then mytime(i) = "0" & mytime(i)
        If Right(mytime(i), 1) = ":" Then mytime(i) = mytime(i) & "00"
        mytime(i) = mytime(i) & ":00"
    Next i
    
    pas = RegexMatch("par\s+pas\s+de\s+([0-9]{1,2}[hm])", time_params)
    If Right(pas, 1) = "h" Then
        pas = CInt(Left(pas, Len(pas) - 1)) * 60
    Else
        pas = CInt(Left(pas, Len(pas) - 1))
    End If
    
    res.Add mytime(0)
    res.Add mytime(1)
    res.Add pas
    Set parseTimeParams = res
End Function

Sub unittest_parseTimeParams()
    Set res1 = parseTimeParams("du 31/01/2015 au 10/02/2015 de 14h30 à 18h par pas de 30min")
    Set res2 = parseTimeParams("du 31/01/2015 au 02/10/2015 de 4:30 à 18:00 par pas de 1h")
End Sub

' renvoie l'adresse mail du carnet outlook global à partir du nom prénom de la personne
Public Function getEmail(ByVal nom_prenom As String) As String
    Dim o As Outlook.Application
    Dim myDelegate As Outlook.Recipient
    Dim pa As Outlook.PropertyAccessor
    Const PR_SMTP_ADDRESS As String = _
        "http://schemas.microsoft.com/mapi/proptag/0x39FE001E"
    On Error Resume Next
    Set o = GetObject(, "Outlook.Application")
    If Err <> 0 Then
       Set o = CreateObject("Outlook.Application")
    End If
    On Error GoTo 0

    Dim myItem As Outlook.TaskItem
    Set myItem = o.CreateItem(olTaskItem)
    myItem.Assign
    Set myDelegate = myItem.recipients.Add(nom_prenom)
    myDelegate.Resolve
    
    If myDelegate.Resolved Then
       Set pa = myDelegate.PropertyAccessor
       getEmail = pa.GetProperty(PR_SMTP_ADDRESS)
    End If
 
End Function

' dit si la liste de personnes (adresses mails séparées par un "|") est dispo entre début et fin
' en option, si opt est non vide, ça liste les personnes non dispo
Function checkAvailability(ByVal recipients As String, ByVal debut As Date, ByVal fin As Date, Optional ByVal opt As String = "")
    ' on initialise outlook
    Dim o As Outlook.Application
    Dim NS As Outlook.Namespace
    On Error Resume Next
    Set o = GetObject(, "Outlook.Application")
    If Err <> 0 Then
        Set o = CreateObject("Outlook.Application")
    End If
    On Error GoTo 0
    Set NS = o.GetNamespace("MAPI")
    
    Dim res As Boolean
    res = True
    unavailable_persons = ""
    persons = Split(recipients, "|")
    pas = 30
    debut_jour = CDate(Format(CDate(debut), "dd/mm/yyyy 00:00:00"))
    For j = 0 To UBound(persons)
        On Error GoTo nextone
        Set objRecipient = NS.CreateRecipient(persons(j))
        strFreeBusyData = objRecipient.FreeBusy(debut, pas)
        slot_dep = DateDiff("n", debut_jour, debut) / pas + 1
        slot_fin = DateDiff("n", debut_jour, fin) / pas
        For i = slot_dep To slot_fin
            If Mid(strFreeBusyData, i, 1) = 1 Then
                res = False
                unavailable_persons = unavailable_persons & persons(j) & ";"
                GoTo nextone
            End If
        Next i
nextone:
    Next j
    
    If opt <> "" Then
        checkAvailability = res & ";" & Left(unavailable_persons, Len(unavailable_persons) - 1)
    Else
        checkAvailability = res
    End If
End Function

Sub unittest_checkavailability()
    
End Sub