1. #1
    Candidat au Club
    Homme Profil pro
    Responsable de service informatique
    Inscrit en
    septembre 2017
    Messages
    9
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 35
    Localisation : France, Pyrénées Atlantiques (Aquitaine)

    Informations professionnelles :
    Activité : Responsable de service informatique
    Secteur : Enseignement

    Informations forums :
    Inscription : septembre 2017
    Messages : 9
    Points : 2
    Points
    2

    Par défaut Création automatisée de rendez-vous depuis lecture de fichier de données .txt

    Bonjour à tous,

    Je parcours votre forum depuis longtemps et cela m'a beaucoup aidé à développer des macros sous excel / outlook pour ma conjointe qui travaille dans une association.
    Cependant la je cale complètement et n'arrive pas à mes fins !

    Je vous présente le contexte :

    Ils ont un outil (base de donnée) ou ils saisissent les rendez-vous, puis saisissent à la main les rendez-vous dans le calendrier outlook. L'idée était de leur simplifier la vie.

    Ils peuvent faire une extraction de cet outil qui sort un fichier .txt contenant les données.
    Ensuite dans outlook, ils auraient un bouton dans le ruban permettant d'aller chercher le fichier texte extrait pour saisir de manière automatisée les rendez-vous dans le calendrier outlook.

    J'ai déjà bien avancé sur le programme, puisque j'ai fait un bouton parcourir qui leur permettra d'aller chercher le fichier texte dans le répertoire de leur choix avec vérification qu'il s'agit bien d'un fichier issu de l'extraction de leur base de donnée.
    Ensuite en macro je transforme le fichier .txt avec comme séparateur "tabulation" en tableau temporaire .xslx contenant l'entête et une ligne par rendez-vous me permettant de lire plus facilement depuis outlook
    Enfin j'arrive déjà à générer un rendez-vous dans outlook pour chaque numéro de visite, avec le coprs du message correspondant.

    Nom : Capture2.JPG
Affichages : 38
Taille : 90,6 Ko

    La ou je coince :

    il peut y avoir plusieurs raisons de visite dans un même rendez-vous sur la journée, du coup dans le fichier excel, il y a donc plusieurs lignes avec le même numéro de visite en colonne A, mais des valeurs différentes dans les colonnes suivantes.
    Il faut donc qu'apparaissent dans le corps du rendez-vous les différentes raisons de visite.
    Ce que j'ai fait ne contient qu'une seule des lignes d'une visite (la première) même s'il y a plusieurs lignes.

    J'ai essayé de recopier chaque ligne correspondant a un numéro de visite en doublon dans une feuille a part, et faire ainsi autant de feuille que de numéro de visite différent pour ensuite lire feuille par feuille pour générer mes rendez vous mais je n'ai pas réussi.

    Du coup je sèche ...




    Voici déjà mon code actuel (pas très propre mais complètement fonctionnel )

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    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
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
     
    Private Sub valider_lecture_Click()
     
     
    'Declaration des variables
    Dim XlApp, XlClasseur
    Dim derniere_ligne As Long
     
     
    'répertoire de stockage du fichier excel temporaire
    repertoire_temporaire = "c:\test\"
     
    'Récupération du nom d'utilisateur en cours de session
    Userlogin = Environ("USERNAME")
     
    'Chemin complet du fichier excel temporaire
    fichier_excel_temp = repertoire_temporaire & "temp-" & Userlogin & ".xlsx"
     
    'Création d'un Excel
    Set XlApp = CreateObject("Excel.Application")
     
    'teste si un fichier à bien été selectionné, si aucun selectionné quitte la macro
    If fichier_txt.Value = "" Then
        GoTo fin
    End If
     
    'Ouverture du classeur
    Set XlClasseur = XlApp.Workbooks.Add
     
    'Enregistrement du fichier excel temporaire
    XlClasseur.SaveAs (fichier_excel_temp)
     
    'On rend le classeur visible
    XlApp.Visible = True
     
    Unload formulaire_choix_fichier
     
    'Conversion du fichier texte extrait en fichier excel
    With XlClasseur.Worksheets("Feuil1").QueryTables.Add(Connection:="TEXT;" & fichier_txt.Value, Destination:=XlClasseur.Worksheets("Feuil1").Range("$A$1"))
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .TextFilePromptOnRefresh = False
            .TextFilePlatform = 1252
            .TextFileStartRow = 1
            .TextFileParseType = xlDelimited
            .TextFileTextQualifier = xlTextQualifierDoubleQuote
            .TextFileConsecutiveDelimiter = False
            .TextFileTabDelimiter = True
            .TextFileSemicolonDelimiter = False
            .TextFileCommaDelimiter = False
            .TextFileSpaceDelimiter = False
            .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 2, 1, 1, 1, 1, 2, 2, 1, 1, 1, 2, 1, 1, _
            1, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
            .TextFileTrailingMinusNumbers = True
            .Refresh BackgroundQuery:=False
    End With
     
    XlClasseur.Save
     
    XlClasseur.Worksheets("Feuil2").Delete
    XlClasseur.Worksheets("Feuil3").Delete
     
    'Recherche de la dernière ligne du tableau
    derniere_ligne = XlClasseur.Worksheets("Feuil1").Range("A" & XlClasseur.Worksheets("Feuil1").Rows.Count).End(xlUp).Row
     
    For i = 2 To derniere_ligne
     
     
        If XlClasseur.Worksheets("Feuil1").Range("A" & i - 1) <> XlClasseur.Worksheets("Feuil1").Range("A" & i) Then
     
    numero_visite = XlClasseur.Worksheets("Feuil1").Range("A" & i)
    raison_sociale = XlClasseur.Worksheets("Feuil1").Range("C" & i)
    adresse1 = XlClasseur.Worksheets("Feuil1").Range("D" & i)
    adresse2 = XlClasseur.Worksheets("Feuil1").Range("E" & i)
    code_postal = XlClasseur.Worksheets("Feuil1").Range("F" & i)
    commune = XlClasseur.Worksheets("Feuil1").Range("G" & i)
    departement = XlClasseur.Worksheets("Feuil1").Range("H" & i) 
    raison_visite = XlClasseur.Worksheets("Feuil1").Range("I" & i)
    produit = XlClasseur.Worksheets("Feuil1").Range("J" & i)
    date_debut = XlClasseur.Worksheets("Feuil1").Range("L" & i)
    date_debut = CDate(date_debut)
    heure_debut_temp = XlClasseur.Worksheets("Feuil1").Range("M" & i)
    heure_debut_temp = CDbl(heure_debut_temp * 24)
    heure_debut_temp = Format(heure_debut_temp, "#.00")
    Dim D As Single, Resultat, e
        'Pour l'exemple
        e = CStr(Round((heure_debut_temp - Int(heure_debut_temp)) / 100 * 60, 2)) & "0"
        heure_debut = CStr(Int(heure_debut_temp)) & ":" & Mid(e, 3, 2)
    If Len(heure_debut) < 4 Then
        heure_debut = heure_debut & "00"
    End If
    temps_prevu_temp = XlClasseur.Worksheets("Feuil1").Range("K" & i)
    temps_prevu = (temps_prevu_temp * 8) * 60
     
    'Creation du RDV et Ecriture du contenu
    Dim olAppt As AppointmentItem
    Set olAppt = Application.CreateItem(olAppointmentItem)
    With olAppt
        .MeetingStatus = olMeeting
        .Subject = "Contrôle : " & raison_sociale & " (" & departement & ")"
        .Start = date_debut & "    " & heure_debut & ":00"
        .Duration = temps_prevu 'durée de rdv, en minutes
        .Body = "Rendez vous de la visite" & numero_visite & " :" & vbCrLf & " pour la raison " & raison_visite & " pour le produit " & produit 'corps du texte de la réunion
        .Location = adresse1 & " " & adresse2 & " " & code_postal & " " & commune 'Lieu du rdv
        'on sauvegarde et ferme
        .Save
    End With
     
    Set olAppt = Nothing
     
     
        End If
     
     
    Next
     
     
     
     
     
     
    XlClasseur.Close True
    'On quitte Excel
    XlApp.Quit
    'On libère la mémoire des variables
    Set XlClasseur = Nothing
    Set XlApp = Nothing
     
     
     
     
    fin:
     
     
    End Sub


    Pourriez vous m'aider à mettre dans le corps du rendez vous le contenu de chaque ligne correspondant à un numéro de visite ?

    Exemple de creation d'un rendez vous souhaité avec plusieurs lignes (4 raisons pour une visite):

    Nom : Capture.JPG
Affichages : 52
Taille : 114,4 Ko


    Le fichier .xlsx contenant les données (très simplifié car contient normalement beaucoup plus de colonnes et d'infos dedans ... )

    projet-Outlook.xlsx



    Un grand merci d'avance !

  2. #2
    Candidat au Club
    Homme Profil pro
    Responsable de service informatique
    Inscrit en
    septembre 2017
    Messages
    9
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 35
    Localisation : France, Pyrénées Atlantiques (Aquitaine)

    Informations professionnelles :
    Activité : Responsable de service informatique
    Secteur : Enseignement

    Informations forums :
    Inscription : septembre 2017
    Messages : 9
    Points : 2
    Points
    2

    Par défaut

    Je vous ai mis le fichier Excel mais la macro est bien développée dans Outlook...

  3. #3
    Candidat au Club
    Homme Profil pro
    Responsable de service informatique
    Inscrit en
    septembre 2017
    Messages
    9
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 35
    Localisation : France, Pyrénées Atlantiques (Aquitaine)

    Informations professionnelles :
    Activité : Responsable de service informatique
    Secteur : Enseignement

    Informations forums :
    Inscription : septembre 2017
    Messages : 9
    Points : 2
    Points
    2

    Par défaut

    Après avoir passé l'après midi dessus ... je me réponds à moi-même !

    J'ai fait une boucle for imbriquée dans la première, je ne sais pas si c'était le plus facile ... mais ca fonctionne !

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    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
    109
    110
    111
    112
    113
    114
    115
    116
    117
    118
    119
    120
    121
    122
    123
    124
    125
    126
    127
    128
    129
    130
    131
    132
    133
    134
    135
    136
    137
    138
    139
    140
    141
    142
    143
    144
    145
    146
    147
    148
    149
    150
    151
    152
    153
    154
    155
    156
    157
    158
    159
    160
    161
    162
    163
    164
    165
    166
    167
    168
    169
    170
    171
    172
    173
    174
    175
    176
    177
    178
    179
    180
    181
    182
    183
    184
    185
    186
    187
    188
    189
    190
    191
    192
    193
    194
    195
    196
    197
    198
    199
    200
    201
    202
    203
    204
    205
    206
    207
    208
    209
    210
    211
    212
    213
    214
    215
    216
    217
    218
    219
    220
    221
    222
    223
    224
    225
    226
    227
    228
    Private Sub valider_lecture_TXT_Click()
     
     
    'Declaration des variables
    Dim XlApp, XlClasseur
    Dim derniere_ligne As Long
     
     
    'répertoire de stockage du fichier excel temporaire
    repertoire_temporaire = "c:\test\"
     
    'Récupération du nom d'utilisateur en cours de session
    Userlogin = Environ("USERNAME")
     
    'Chemin complet du fichier excel temporaire
    fichier_excel_temp = repertoire_temporaire & "tempTXT-" & Userlogin & ".xlsx"
     
    'Création d'un Excel
    Set XlApp = CreateObject("Excel.Application")
     
    'teste si un fichier à bien été selectionné, si aucun selectionné quitte la macro
    If fichier_TXT.Value = "" Then
        GoTo fin
    End If
     
    'Ouverture du classeur
    Set XlClasseur = XlApp.Workbooks.Add
     
    'Enregistrement du fichier excel temporaire
    XlClasseur.SaveAs (fichier_excel_temp)
     
    'On rend le classeur visible
    XlApp.Visible = True
     
    Unload formulaire_TXT
     
    'Conversion du fichier texte extrait de TXT en fichier excel
    With XlClasseur.Worksheets("Feuil1").QueryTables.Add(Connection:="TEXT;" & fichier_TXT.Value, Destination:=XlClasseur.Worksheets("Feuil1").Range("$A$1"))
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .TextFilePromptOnRefresh = False
            .TextFilePlatform = 1252
            .TextFileStartRow = 1
            .TextFileParseType = xlDelimited
            .TextFileTextQualifier = xlTextQualifierDoubleQuote
            .TextFileConsecutiveDelimiter = False
            .TextFileTabDelimiter = True
            .TextFileSemicolonDelimiter = False
            .TextFileCommaDelimiter = False
            .TextFileSpaceDelimiter = False
            .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 2, 1, 1, 1, 1, 2, 2, 1, 1, 1, 2, 1, 1, _
            1, 2, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
            .TextFileTrailingMinusNumbers = True
            .Refresh BackgroundQuery:=False
    End With
     
    XlClasseur.Save
     
    XlClasseur.Worksheets("Feuil2").Delete
    XlClasseur.Worksheets("Feuil3").Delete
     
    'Recherche de la dernière ligne du tableau
    derniere_ligne = XlClasseur.Worksheets("Feuil1").Range("A" & XlClasseur.Worksheets("Feuil1").Rows.Count).End(xlUp).Row
     
    For i = 2 To derniere_ligne
     
        numero_visite = ""
     
        If XlClasseur.Worksheets("Feuil1").Range("A" & i + 1) <> XlClasseur.Worksheets("Feuil1").Range("A" & i) Then
     
            'If XlClasseur.Worksheets("Feuil1").Range("A" & i - 1) <> XlClasseur.Worksheets("Feuil1").Range("A" & i) Then
     
                numero_visite = XlClasseur.Worksheets("Feuil1").Range("A" & i)
                raison_sociale = XlClasseur.Worksheets("Feuil1").Range("C" & i)
                departement = XlClasseur.Worksheets("Feuil1").Range("L" & i)
                adresse1 = XlClasseur.Worksheets("Feuil1").Range("G" & i)
                adresse2 = XlClasseur.Worksheets("Feuil1").Range("H" & i)
                code_postal = XlClasseur.Worksheets("Feuil1").Range("I" & i)
                commune = XlClasseur.Worksheets("Feuil1").Range("J" & i)
                responsable = XlClasseur.Worksheets("Feuil1").Range("M" & i)
                telephone1 = XlClasseur.Worksheets("Feuil1").Range("N" & i)
                telephone2 = XlClasseur.Worksheets("Feuil1").Range("O" & i)
                mail = XlClasseur.Worksheets("Feuil1").Range("Q" & i)
                date_debut = XlClasseur.Worksheets("Feuil1").Range("AM" & i)
                date_debut = CDate(date_debut)
                heure_debut_temp = XlClasseur.Worksheets("Feuil1").Range("AO" & i)
                heure_debut_temp = CDbl(heure_debut_temp * 24)
                heure_debut_temp = Format(heure_debut_temp, "#.00")
                Dim D As Single, Resultat, e
                'Pour l'exemple
                e = CStr(Round((heure_debut_temp - Int(heure_debut_temp)) / 100 * 60, 2)) & "0"
                heure_debut = CStr(Int(heure_debut_temp)) & ":" & Mid(e, 3, 2)
                If Len(heure_debut) < 4 Then
                    heure_debut = heure_debut & "00"
                End If
                temps_prevu_temp = XlClasseur.Worksheets("Feuil1").Range("AJ" & i)
                temps_prevu = (temps_prevu_temp * 8) * 60
                corps_rdv = "Numéro de visite : " & numero_visite & vbCrLf & vbCrLf  'corps du texte de la réunion
                corps_rdv = corps_rdv & "Contact : " & vbCrLf
                corps_rdv = corps_rdv & responsable
                If telephone1 <> "" Then
                    corps_rdv = corps_rdv & "   " & telephone1
                End If
                If telephone2 <> "" Then
                    corps_rdv = corps_rdv & "   " & telephone2
                End If
                If mail <> "" Then
                    corps_rdv = corps_rdv & "   " & mail
                End If
                corps_rdv = corps_rdv & vbCrLf & vbCrLf
                corps_rdv = corps_rdv & "Durée de la visite (j) : " & temps_prevu_temp & vbCrLf & vbCrLf
                corps_rdv = corps_rdv & "Contenu de la visite : " & vbCrLf
                corps_rdv = corps_rdv & " " & XlClasseur.Worksheets("Feuil1").Range("y" & i)
     
            'End If
     
     
        Else
                'If XlClasseur.Worksheets("Feuil1").Range("A" & i - 1) <> XlClasseur.Worksheets("Feuil1").Range("A" & i) Then
     
                numero_visite = XlClasseur.Worksheets("Feuil1").Range("A" & i)
                raison_sociale = XlClasseur.Worksheets("Feuil1").Range("C" & i)
                departement = XlClasseur.Worksheets("Feuil1").Range("L" & i)
                adresse1 = XlClasseur.Worksheets("Feuil1").Range("G" & i)
                adresse2 = XlClasseur.Worksheets("Feuil1").Range("H" & i)
                code_postal = XlClasseur.Worksheets("Feuil1").Range("I" & i)
                commune = XlClasseur.Worksheets("Feuil1").Range("J" & i)
                responsable = XlClasseur.Worksheets("Feuil1").Range("M" & i)
                telephone1 = XlClasseur.Worksheets("Feuil1").Range("N" & i)
                telephone2 = XlClasseur.Worksheets("Feuil1").Range("O" & i)
                mail = XlClasseur.Worksheets("Feuil1").Range("Q" & i)
                date_debut = XlClasseur.Worksheets("Feuil1").Range("AM" & i)
                date_debut = CDate(date_debut)
                heure_debut_temp = XlClasseur.Worksheets("Feuil1").Range("AO" & i)
                heure_debut_temp = CDbl(heure_debut_temp * 24)
                heure_debut_temp = Format(heure_debut_temp, "#.00")
                'Pour l'exemple
                e = CStr(Round((heure_debut_temp - Int(heure_debut_temp)) / 100 * 60, 2)) & "0"
                heure_debut = CStr(Int(heure_debut_temp)) & ":" & Mid(e, 3, 2)
                If Len(heure_debut) < 4 Then
                    heure_debut = heure_debut & "00"
                End If
                temps_prevu_temp = XlClasseur.Worksheets("Feuil1").Range("AJ" & i)
                temps_prevu = (temps_prevu_temp * 8) * 60
                corps_rdv = "Numéro de visite : " & numero_visite & vbCrLf & vbCrLf  'corps du texte de la réunion
                corps_rdv = corps_rdv & "Contact : " & vbCrLf
                corps_rdv = corps_rdv & responsable
                If telephone1 <> "" Then
                    corps_rdv = corps_rdv & "   " & telephone1
                End If
                If telephone2 <> "" Then
                    corps_rdv = corps_rdv & "   " & telephone2
                End If
                If mail <> "" Then
                    corps_rdv = corps_rdv & "   " & mail
                End If
                corps_rdv = corps_rdv & vbCrLf & vbCrLf
                corps_rdv = corps_rdv & "Durée de la visite (j) : " & temps_prevu_temp & vbCrLf & vbCrLf
                corps_rdv = corps_rdv & "Contenu de la visite : " & vbCrLf
     
     
                For J = i To derniere_ligne
     
                    If XlClasseur.Worksheets("Feuil1").Range("A" & J) = XlClasseur.Worksheets("Feuil1").Range("A" & i) Then
     
                        corps_rdv = corps_rdv & " " & XlClasseur.Worksheets("Feuil1").Range("y" & J) & vbCrLf 'corps du texte de la réunion
                        num_ligne = J
     
                    End If
     
     
                Next
     
                i = num_ligne '- 1
     
        End If
     
        If numero_visite <> "" Then
     
                'Creation du RDV et Ecriture du contenu
                Dim olAppt As AppointmentItem
                Set olAppt = Application.CreateItem(olAppointmentItem)
                With olAppt
                    .MeetingStatus = olMeeting
                    'Sujet on récupère l'utilisateur en cours de session
                    .Subject = "Contrôle : " & raison_sociale & " (" & departement & ")"
                    .Start = date_debut & "    " & heure_debut & ":00"
                    '.End = date_depart.Value & "    " & heure_fin.Value & ":00"
                    .Duration = temps_prevu 'durée de rdv, en minutes
                    .Body = corps_rdv
                    .Location = adresse1 & " " & adresse2 & " " & code_postal & " " & commune 'Lieu du rdv
                    'on sauvegarde et ferme
                    .Save
                End With
                Set olAppt = Nothing
        End If
     
     
     
    Next
     
     
     
     
     
     
    XlClasseur.Close True
    'On quitte Excel
    XlApp.Quit
    'On libère la mémoire des variables
    Set XlClasseur = Nothing
    Set XlApp = Nothing
     
     
     
     
    fin:
     
     
    End Sub

    Maintenant autre question ... si j'importe deux fois le même fichier txt cela me crée deux fois les rendez-vous !
    Savez vous s'il y a moyen de vérifier que le rendez-vous existe déjà avant de le créer ?

    Vérifications a faire :

    - numéro de visite
    - jour de visite
    - heure de départ

    Car un rendez vous ayant un numéro de visite unique peut avoir été décalé dans le temps. Il faudrait alors supprimer l'ancien et mettre le nouveau à la place.

  4. #4
    Expert confirmé
    Avatar de Oliv-
    Homme Profil pro
    solution provider
    Inscrit en
    mars 2006
    Messages
    3 003
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 46
    Localisation : France, Nord (Nord Pas de Calais)

    Informations professionnelles :
    Activité : solution provider

    Informations forums :
    Inscription : mars 2006
    Messages : 3 003
    Points : 5 254
    Points
    5 254
    Billets dans le blog
    13

    Par défaut

    Salut,

    Il faut que tu puisses identifier à coup sûr ton RDV! moi j'indiquerai dans le Subject :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
       .Subject = "Contrôle : " & raison_sociale & " (" & departement & ") #" & numero_visite

    ce qui te permettra de chercher via ce numéro de visite le # est là pour rendre unique cette info.

    Regarde le code dans ce sujet
    https://www.developpez.net/forums/d1...t/#post8831383

  5. #5
    Candidat au Club
    Homme Profil pro
    Responsable de service informatique
    Inscrit en
    septembre 2017
    Messages
    9
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 35
    Localisation : France, Pyrénées Atlantiques (Aquitaine)

    Informations professionnelles :
    Activité : Responsable de service informatique
    Secteur : Enseignement

    Informations forums :
    Inscription : septembre 2017
    Messages : 9
    Points : 2
    Points
    2

    Par défaut

    Citation Envoyé par Oliv- Voir le message
    Salut,

    Il faut que tu puisses identifier à coup sûr ton RDV! moi j'indiquerai dans le Subject :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
       .Subject = "Contrôle : " & raison_sociale & " (" & departement & ") #" & numero_visite

    ce qui te permettra de chercher via ce numéro de visite le # est là pour rendre unique cette info.

    Regarde le code dans ce sujet
    https://www.developpez.net/forums/d1...t/#post8831383


    ok merci !
    J'avais pensé également faire apparaitre le numéro de visite dans le sujet du rdv ce qui me permettais de retrouver plus facilement le RDV.
    Le # n'a pas de fonction particulière ? c'est juste pour concaténer le numéro de visite avec afin d'avoir un numero de visite sous la forme #seriedechiffre afin d'éviter d'avoir un retour d'un sujet contenant une série de chiffre identique c'est ca ?

    Par contre du coup, il peut y avoir un rendez-vous qui a été décalé, auquel cas le numéro de visite de leur logiciel reste inchangé, simplement la date de planification qui sera modifiée, soit par le jour, soit l'heure voire les deux.
    C'est cette partie de ton code qui me permettra la comparaison ?

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    Set MonApp = Outlook.Application
    Set MonNameSpace = MonApp.GetNamespace("MAPI")
     
    'On pointe sur le calendrier pour chercher les valeurs a copier
    Set MonDoss = MonNameSpace.GetDefaultFolder(olFolderCalendar) 'ou le GetSharedDefaultFolder
     
     
     
    For Each EvenCalend In MonDoss.Items
     
          'On definit les variables de l'événement, debut, fin, sujet etc.
          Sujet = EvenCalend.Subject
          If InStr(1, Sujet, "Congés", vbTextCompare) > 0 Then    
     
                'On definit les variables de l'événement, début, fin, sujet etc.
                Sujet = EvenCalend.Subject
                DateDeb = EvenCalend.Start
          end if
    Next EvenCalend

    If InStr(1, Sujet, "Congés", vbTextCompare) > 0 Then ------> c'est la que je fais ma recherche sur le numéro de visite en changeant "congés" par ma variable "numero_visite" lue du fichier excel ?

    et je fais des comparaisons entre :

    DateDeb = EvenCalend.Start -----> ma variable date_debut & " " & heure_debut & ":00" lue du fichier excel ?

    En gros avant ma creation de RDV :

    lecture du calendrier à la recherche d'un RDV avec le même numéro de visite

    if numero de visite trouvé alors
    if comparaison .start <> ma variable excel
    Creation du rendez-vous et suppression de l'ancien ? ou je peux uniquement le déplacer avec le nouveau .start ?
    end if
    else
    creation du rdv
    end if



    En tout cas merci d'avance pour ton aide !!!

    PS: pas trop pourri mon code ??? Je suis absolument pas du tout programmeur car autodidacte en la matière ... du coup je me demande parfois si je me complique pas la tache pour rien avec certaines de mes macros ...
    J'ai pas fini de tout commenter, j'ai envoyé la version brute après avoir trouvé la solution, il faut que je fasse un peu de nettoyage dedans ...

  6. #6
    Expert confirmé
    Avatar de Oliv-
    Homme Profil pro
    solution provider
    Inscrit en
    mars 2006
    Messages
    3 003
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 46
    Localisation : France, Nord (Nord Pas de Calais)

    Informations professionnelles :
    Activité : solution provider

    Informations forums :
    Inscription : mars 2006
    Messages : 3 003
    Points : 5 254
    Points
    5 254
    Billets dans le blog
    13

    Par défaut

    Citation Envoyé par buggzbeny Voir le message
    ok merci !
    J'avais pensé également faire apparaitre le numéro de visite dans le sujet du rdv ce qui me permettais de retrouver plus facilement le RDV.
    Le # n'a pas de fonction particulière ? c'est juste pour concaténer le numéro de visite avec afin d'avoir un numero de visite sous la forme #seriedechiffre afin d'éviter d'avoir un retour d'un sujet contenant une série de chiffre identique c'est ca ?
    OUI
    Par contre du coup, il peut y avoir un rendez-vous qui a été décalé, auquel cas le numéro de visite de leur logiciel reste inchangé, simplement la date de planification qui sera modifiée, soit par le jour, soit l'heure voire les deux.
    C'est cette partie de ton code qui me permettra la comparaison ?
    Plutot l'utilisation de la fonction? MAIS TELLE QUELLE elle n'accepte que les sujets identiques (je vais la modifier...)
    l'idée c'est pour gagner du temps d'utiliser restrict pour limiter le nombre de rdv à comparer, soit sur le sujet ou la période

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    if fc_AppointmentExist (EvenCalend.Start,EvenCalend.subject,MonSousDoss)=True then
     
    'Existe donc suppression de l'ancien
     
    End if
     
    ' ICI CREATION DU RDV

    If InStr(1, Sujet, "Congés", vbTextCompare) > 0 Then ------> c'est la que je fais ma recherche sur le numéro de visite en changeant "congés" par ma variable "numero_visite" lue du fichier excel ?

    et je fais des comparaisons entre :

    DateDeb = EvenCalend.Start -----> ma variable date_debut & " " & heure_debut & ":00" lue du fichier excel ?

    En gros avant ma creation de RDV :

    lecture du calendrier à la recherche d'un RDV avec le même numéro de visite

    if numero de visite trouvé alors
    if comparaison .start <> ma variable excel
    Creation du rendez-vous et suppression de l'ancien ? ou je peux uniquement le déplacer avec le nouveau .start ?
    end if
    else
    creation du rdv
    end if


    En tout cas merci d'avance pour ton aide !!!

    PS: pas trop pourri mon code ??? Je suis absolument pas du tout programmeur car autodidacte en la matière ... du coup je me demande parfois si je me complique pas la tache pour rien avec certaines de mes macros ...
    J'ai pas fini de tout commenter, j'ai envoyé la version brute après avoir trouvé la solution, il faut que je fasse un peu de nettoyage dedans ...

  7. #7
    Candidat au Club
    Homme Profil pro
    Responsable de service informatique
    Inscrit en
    septembre 2017
    Messages
    9
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 35
    Localisation : France, Pyrénées Atlantiques (Aquitaine)

    Informations professionnelles :
    Activité : Responsable de service informatique
    Secteur : Enseignement

    Informations forums :
    Inscription : septembre 2017
    Messages : 9
    Points : 2
    Points
    2

    Par défaut

    Re moi !

    Tu vas me prendre pour une buse mais je n'arrive pas à utiliser ta fonction

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    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
    If numero_visite <> "" Then
     
                Set MonApp = Outlook.Application
                Set MonNameSpace = MonApp.GetNamespace("MAPI")
                Dim MonSousDoss As Outlook.Folder
     
                'On pointe sur le calendrier pour chercher les valeurs a copier
                Set MonDoss = MonNameSpace.GetDefaultFolder(olFolderCalendar) 'ou le GetSharedDefaultFolder
                Set MonSousDoss = MonDoss.Folders(1)
     
     
                If fc_AppointmentExist("Contrôle : " & raison_sociale & " (" & departement & ") #" & numero_visite, MonSousDoss) = True Then
     
                    'Call DeleteAppointments(EvenCalend_Subject)
                    MsgBox ("existe")
     
                End If
     
                'Creation du RDV et Ecriture du contenu
                Dim outlookAppt As AppointmentItem
                Set outlookAppt = Application.CreateItem(olAppointmentItem)
                With outlookAppt
                    .MeetingStatus = olMeeting
                    'Sujet on récupère l'utilisateur en cours de session
                    .Subject = "Contrôle : " & raison_sociale & " (" & departement & ") #" & numero_visite
                    .Start = date_debut & "    " & heure_debut & ":00"
                    '.End = date_depart.Value & "    " & heure_fin.Value & ":00"
                    .Duration = temps_prevu 'durée de rdv, en minutes
                    .Body = corps_rdv
                    .Location = adresse1 & " " & adresse2 & " " & code_postal & " " & commune 'Lieu du rdv
                    'on sauvegarde et ferme
                    .Save
                End With
                Set outlookAppt = Nothing
        End If

    J'ai modifié la fonction de cette manière :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    Function fc_AppointmentExist(Sujet As String, MyAgendaFolder As Outlook.Folder) As Boolean
        Dim searchAgenda As Items
        Dim filtre
         fc_AppointmentExist = False
        Set searchAgenda = MyAgendaFolder.Items
        filtre = "[Subject] = '" & Sujet & "'"
        Set searchAgenda = searchAgenda.Restrict(filtre)
        If searchAgenda.Count > 0 Then fc_AppointmentExist = True
     
    End Function
    je ne cherche que le sujet qui dans tous les cas est unique ... malgrè que le rendez vous existe déjà ... la fonction ne le trouve pas puisqu'il ne m'affiche pas le msgbox ...

    peux tu m'aider ? merci !

  8. #8
    Candidat au Club
    Homme Profil pro
    Responsable de service informatique
    Inscrit en
    septembre 2017
    Messages
    9
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 35
    Localisation : France, Pyrénées Atlantiques (Aquitaine)

    Informations professionnelles :
    Activité : Responsable de service informatique
    Secteur : Enseignement

    Informations forums :
    Inscription : septembre 2017
    Messages : 9
    Points : 2
    Points
    2

    Par défaut

    Je t'ai fait une infidélité !!!!

    J'ai trouvé sur un site une macro pour modifier un rendez vous existant que j'ai inséré dans mon code :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    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
     
        If numero_visite <> "" Then
     
     
                'déclaration des variables
                Dim oOutlook As Outlook.Application
                Dim oAppointment As Outlook.AppointmentItem
     
                Dim namespaceOutlook As Outlook.NameSpace
                Dim DossierCalendrier As Outlook.MAPIFolder
     
                Dim sFilter As String
     
                'on crée ensuite les objets
                Set oOutlook = CreateObject("Outlook.Application")
                Set namespaceOutlook = oOutlook.GetNamespace("MAPI")
     
                'définit le dossier calendrier
                Set DossierCalendrier = namespaceOutlook.GetDefaultFolder(olFolderCalendar)
     
                sujetrdv = "Contrôle : " & raison_sociale & " (" & departement & ") #" & numero_visite
                'on définit les critères de filtre afin de retrouver le rdv créé
                sFilter = "[Subject] = '" & sujetrdv & "' "
     
                'on cherche le ou les rdv correspondant aux critères
                Set oAppointment = DossierCalendrier.Items.Find(sFilter)
     
                'si au moins un rdv a été trouvé
                If Not oAppointment Is Nothing Then
                   With oAppointment
                        .Start = date_debut & "    " & heure_debut & ":00"
                        '.End = date_depart.Value & "    " & heure_fin.Value & ":00"
                        .Duration = temps_prevu 'durée de rdv, en minutes
                        .Body = corps_rdv
                        .Location = adresse1 & " " & adresse2 & " " & code_postal & " " & commune 'Lieu du rdv
                        'on sauvegarde et ferme
                        .Save
                    End With
                    Set oAppointment = Nothing
     
                Else
     
                    'Creation du RDV et Ecriture du contenu
                    Dim outlookAppt As AppointmentItem
                    Set outlookAppt = Application.CreateItem(olAppointmentItem)
                    With outlookAppt
                        .MeetingStatus = olMeeting
                        'Sujet on récupère l'utilisateur en cours de session
                        .Subject = "Contrôle : " & raison_sociale & " (" & departement & ") #" & numero_visite
                        .Start = date_debut & "    " & heure_debut & ":00"
                        '.End = date_depart.Value & "    " & heure_fin.Value & ":00"
                        .Duration = temps_prevu 'durée de rdv, en minutes
                        .Body = corps_rdv
                        .Location = adresse1 & " " & adresse2 & " " & code_postal & " " & commune 'Lieu du rdv
                        'on sauvegarde et ferme
                        .Save
                    End With
                    Set outlookAppt = Nothing
                End If
     
     
     
        End If

    Il modifie un rendez-vous existant si l'heure et/ou date ont changé et j'ai rajouté un else pour la création s'il n'existe pas ... et ca fonctionne !

    J'ai plus qu'a bien commenter mon code et nettoyer tous mes tests ...

    En tout cas merci beaucoup pour ton aide !

  9. #9
    Expert confirmé
    Avatar de Oliv-
    Homme Profil pro
    solution provider
    Inscrit en
    mars 2006
    Messages
    3 003
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 46
    Localisation : France, Nord (Nord Pas de Calais)

    Informations professionnelles :
    Activité : solution provider

    Informations forums :
    Inscription : mars 2006
    Messages : 3 003
    Points : 5 254
    Points
    5 254
    Billets dans le blog
    13

    Par défaut

    Citation Envoyé par buggzbeny Voir le message
    Re moi !

    Tu vas me prendre pour une buse mais je n'arrive pas à utiliser ta fonction

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    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
    If numero_visite <> "" Then
     
                Set MonApp = Outlook.Application
                Set MonNameSpace = MonApp.GetNamespace("MAPI")
                Dim MonSousDoss As Outlook.Folder
     
                'On pointe sur le calendrier pour chercher les valeurs a copier
                Set MonDoss = MonNameSpace.GetDefaultFolder(olFolderCalendar) 'ou le GetSharedDefaultFolder
                Set MonSousDoss = MonDoss.Folders(1)
     
     
                If fc_AppointmentExist("Contrôle : " & raison_sociale & " (" & departement & ") #" & numero_visite, MonSousDoss) = True Then
     
                    'Call DeleteAppointments(EvenCalend_Subject)
                    MsgBox ("existe")
     
                End If
     
                'Creation du RDV et Ecriture du contenu
                Dim outlookAppt As AppointmentItem
                Set outlookAppt = Application.CreateItem(olAppointmentItem)
                With outlookAppt
                    .MeetingStatus = olMeeting
                    'Sujet on récupère l'utilisateur en cours de session
                    .Subject = "Contrôle : " & raison_sociale & " (" & departement & ") #" & numero_visite
                    .Start = date_debut & "    " & heure_debut & ":00"
                    '.End = date_depart.Value & "    " & heure_fin.Value & ":00"
                    .Duration = temps_prevu 'durée de rdv, en minutes
                    .Body = corps_rdv
                    .Location = adresse1 & " " & adresse2 & " " & code_postal & " " & commune 'Lieu du rdv
                    'on sauvegarde et ferme
                    .Save
                End With
                Set outlookAppt = Nothing
        End If

    J'ai modifié la fonction de cette manière :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    Function fc_AppointmentExist(Sujet As String, MyAgendaFolder As Outlook.Folder) As Boolean
        Dim searchAgenda As Items
        Dim filtre
         fc_AppointmentExist = False
        Set searchAgenda = MyAgendaFolder.Items
        filtre = "[Subject] = '" & Sujet & "'"
        Set searchAgenda = searchAgenda.Restrict(filtre)
        If searchAgenda.Count > 0 Then fc_AppointmentExist = True
     
    End Function
    je ne cherche que le sujet qui dans tous les cas est unique ... malgrè que le rendez vous existe déjà ... la fonction ne le trouve pas puisqu'il ne m'affiche pas le msgbox ...

    peux tu m'aider ? merci !
    Salut,

    Par rapport à ton autre code le suivant, je remarque que tu ne pointe pas sur le même dossier, ton rdv est-il bien dans le sous-dossier de calendrier ?

    Effectivement avec cette syntaxe tu doit mettre le sujet exact ! la question que tu dois te poser c'est est-ce que ce Sujet
    "Contrôle : " & raison_sociale & " (" & departement & ") #" & numero_visite
    est bien unique et ne peut changer !

    Sinon pour rechercher "contient" #numero_visite dans le sujet voici un code qui devrait fonctionner

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    Function fc_AppointmentExist(Sujet As String, MyAgendaFolder As Outlook.Folder) As Boolean
        Dim searchAgenda As Items
        Dim filtre
        fc_AppointmentExist = False
        Set searchAgenda = MyAgendaFolder.Items
        filtre = "@SQL=" & Chr(34) _
                 & "urn:schemas:httpmail:subject" & Chr(34) _
                 & " ci_phrasematch '" & Sujet & "'"
        Set searchAgenda = searchAgenda.Restrict(filtre)
        If searchAgenda.Count > 0 Then fc_AppointmentExist = True
     
    End Function

    et si aucuns autres changements ne peut intervenir en dehors de ta macro, (comme des notes ajoutées etc) tu peux simplement supprimer le rdv puis le recréer comme s'il n'existait pas.
    Pour supprimer

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    For i= searchAgenda.Count to 1 step -1
    searchAgenda(i).delete
    Next i

  10. #10
    Expert confirmé
    Avatar de Oliv-
    Homme Profil pro
    solution provider
    Inscrit en
    mars 2006
    Messages
    3 003
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 46
    Localisation : France, Nord (Nord Pas de Calais)

    Informations professionnelles :
    Activité : solution provider

    Informations forums :
    Inscription : mars 2006
    Messages : 3 003
    Points : 5 254
    Points
    5 254
    Billets dans le blog
    13

    Par défaut

    Citation Envoyé par buggzbeny Voir le message
    Je t'ai fait une infidélité !!!!

    J'ai trouvé sur un site une macro pour modifier un rendez vous existant que j'ai inséré dans mon code :

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
     
    ...
                Set oAppointment = DossierCalendrier.Items.Find(sFilter)
     
                'si au moins un rdv a été trouvé
                If Not oAppointment Is Nothing Then
                   With oAppointment
                        .Start = date_debut & "    " & heure_debut & ":00"
                        '.End = date_depart.Value & "    " & heure_fin.Value & ":00"
                        .Duration = temps_prevu 'durée de rdv, en minutes
                        .Body = corps_rdv
                        .Location = adresse1 & " " & adresse2 & " " & code_postal & " " & commune 'Lieu du rdv
                        'on sauvegarde et ferme
                        .Save
                    End With
                    Set oAppointment = Nothing
     
                Else
       ...

    Il modifie un rendez-vous existant si l'heure et/ou date ont changé et j'ai rajouté un else pour la création s'il n'existe pas ... et ca fonctionne !

    J'ai plus qu'a bien commenter mon code et nettoyer tous mes tests ...

    En tout cas merci beaucoup pour ton aide !
    Pour info find et restrict utilisent les mêmes filtres, restrict te renvois la collection des items répondant à ce filtre, par contre find te renvoi le PREMIER uniquement, si tu es sûr de l'unicité du rdv c'est très bien comme cela , sinon tu dois utiliser une boucle

    findnext

    Sub DemoFindNext()
    Dim myNameSpace As Outlook.NameSpace
    Dim tdystart As Date
    Dim tdyend As Date
    Dim myAppointments As Outlook.Items
    Dim currentAppointment As Outlook.AppointmentItem

    Set myNameSpace = Application.GetNamespace("MAPI")
    tdystart = VBA.Format(Now, "Short Date")
    tdyend = VBA.Format(Now + 1, "Short Date")
    Set myAppointments = myNameSpace.GetDefaultFolder(olFolderCalendar).Items
    Set currentAppointment = myAppointments.Find("[Start] >= """ & tdystart & """ and [Start] <= """ & tdyend & """")
    While TypeName(currentAppointment) <> "Nothing"
    MsgBox currentAppointment.Subject
    Set currentAppointment = myAppointments.FindNext
    Wend
    End Sub

  11. #11
    Candidat au Club
    Homme Profil pro
    Responsable de service informatique
    Inscrit en
    septembre 2017
    Messages
    9
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 35
    Localisation : France, Pyrénées Atlantiques (Aquitaine)

    Informations professionnelles :
    Activité : Responsable de service informatique
    Secteur : Enseignement

    Informations forums :
    Inscription : septembre 2017
    Messages : 9
    Points : 2
    Points
    2

    Par défaut

    Bonjour,

    Oui le sujet de rendez-vous est unique. Effectivement par une (fausse) manipulation le sujet peut être modifié manuellement, dans ce cas la le rendez-vous sera créé en double.
    Il faudrait alors que dans le code trouvé sur le net, je ne cherche pas l'intégralité du sujet mais uniquement le #numerodevisite qui lui est unique c'est sur !

    Si je prends ton filtre pour chercher la chaine #numerodevisite que j'insère dans le cote que j'ai trouvé hier cela va t il fonctionner ?

    Je suis au boulot la et je développe la macro à la maison donc je ne peux pas tester ...


    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
       Dim oOutlook As Outlook.Application
                Dim oAppointment As Outlook.AppointmentItem
     
                Dim namespaceOutlook As Outlook.NameSpace
                Dim DossierCalendrier As Outlook.MAPIFolder
     
                Dim sFilter As String
     
                'on crée ensuite les objets
                Set oOutlook = CreateObject("Outlook.Application")
                Set namespaceOutlook = oOutlook.GetNamespace("MAPI")
     
                'définit le dossier calendrier
                Set DossierCalendrier = namespaceOutlook.GetDefaultFolder(olFolderCalendar)
     
                sujetrdv = "#" & numero_visite
                'on définit les critères de filtre afin de retrouver le rdv créé
                sFilter = "@SQL=" & Chr(34) _
                 & "urn:schemas:httpmail:subject" & Chr(34) _
                 & " ci_phrasematch '" & sujetrdv & "'"
     
                'on cherche le ou les rdv correspondant aux critères
                Set oAppointment = DossierCalendrier.Items.Find(sFilter)

    Ensuite oui il peut y avoir des ajouts de notes faites manuellement, c'est pour cela que j'ai préféré déplacer et non supprimer pour re créer.

    Merci beaucoup

  12. #12
    Candidat au Club
    Homme Profil pro
    Responsable de service informatique
    Inscrit en
    septembre 2017
    Messages
    9
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 35
    Localisation : France, Pyrénées Atlantiques (Aquitaine)

    Informations professionnelles :
    Activité : Responsable de service informatique
    Secteur : Enseignement

    Informations forums :
    Inscription : septembre 2017
    Messages : 9
    Points : 2
    Points
    2

    Par défaut

    Encore moi !

    Est il possible d'ajouter les rendez vous directement aux utilisateurs concernés ?

    Y'a bien la notion de participants, mais il faut qu'ils valident le rendez vous pour que ce dernier apparaissent dans leur calendrier personnel ...

    Partant du principe que l'utilisateur qui fera l'importation aura les droits d’écriture dans les calendriers des personnels concernés ...

    Merci

  13. #13
    Expert confirmé
    Avatar de Oliv-
    Homme Profil pro
    solution provider
    Inscrit en
    mars 2006
    Messages
    3 003
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 46
    Localisation : France, Nord (Nord Pas de Calais)

    Informations professionnelles :
    Activité : solution provider

    Informations forums :
    Inscription : mars 2006
    Messages : 3 003
    Points : 5 254
    Points
    5 254
    Billets dans le blog
    13

    Par défaut

    Bonjour,
    Oui il y a 2 façon d'atteindre un calendrier partagé

    Soit il est affiché dans tes calendriers / "Calendriers partagés"

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    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
     
    Sub AjoutDansCalendrierPartagé()
    '---------------------------------------------------------------------------------------
    ' Procedure : AjoutDansCalendrierPartagé
    ' Author    : Oliv
    ' Date      : 13/09/2017
    ' Purpose   :
    '---------------------------------------------------------------------------------------
    '
        Dim OL As Outlook.Application
        If UCase(Application) = "OUTLOOK" Then
            Set OL = Application
        Else
            Set OL = CreateObject("outlook.application")
        End If
        Dim objNS As Outlook.Namespace
        Dim objExpCal As Outlook.Explorer
        Dim objNavMod As Outlook.CalendarModule
        Dim objNavCalPart As Outlook.NavigationFolders
        Dim i, objNavFolder As Outlook.NavigationFolder, FolderPartage As Outlook.Folder
     
     
        Nom = "GsNord Paq" ' attention sensible à la casse
        Set objNS = OL.Session
        Set objExpCal = objNS.GetDefaultFolder(olFolderCalendar).GetExplorer
        Set objNavMod = objExpCal.NavigationPane.Modules.GetNavigationModule(olModuleCalendar)
     
     
        Set objNavCalPart = objNavMod.NavigationGroups.Item("Calendriers partagés").NavigationFolders
     
        Set objNavFolder = objNavCalPart(Nom)
     
        On Error Resume Next
        FoldName = objNavFolder.Folder.Name & "-" & objNavFolder.Folder.FullFolderPath
        If Err Then
            FoldName = "Pas accessible"
            MsgBox objitem & "-->" & FoldName, vbCritical
        Else
            MsgBox Nom & vbCr & FoldName, , "Accès autorisé à "
            Set FolderPartage = objNavFolder.Folder
            'ICI LE TRAITEMENT
            On Error GoTo 0
     
            Dim olcal As Outlook.AppointmentItem
            Set olcal = FolderPartage.Items.Add
            olcal.Subject = "test"
            olcal.Start = Now
            olcal.Duration = 60    'durée de rdv, en minutes
            olcal.Save
     
     
        End If
    End Sub


    Soit tu le recherches avec le nom de la personne ou son email

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    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
    Private Sub Calendrier_partagé()
        Dim FolderPartage As Folder
        Dim OL As Outlook.Application
        Dim myrecipient As Recipient
        Dim objNS As Outlook.NameSpace
        If UCase(Application) = "OUTLOOK" Then
            Set OL = Application
        Else
            Set OL = CreateObject("outlook.application")
        End If
        Set objNS = OL.Session
        Set myrecipient = objNS.CreateRecipient("SOPHIE@TOTO.com")
     
        myrecipient.Resolve
        If myrecipient.Resolved Then
            Set FolderPartage = _
            objNS.GetSharedDefaultFolder _
                                (myrecipient, olFolderCalendar)
        End If
        On Error Resume Next
        accèsAutorisé = FolderPartage
        If Err Then
            MsgBox myrecipient, vbCritical, "Accès NON autorisé"
        Else
            MsgBox myrecipient & vbCr & FolderPartage, , "Accès autorisé à "
              On Error GoTo 0
            'ICI LE TRAITEMENT
     
        End If
    End Sub
    tu noteras que dans le cas d'un autre dossier ou n'utilise pas createitem mais add
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
            Dim olcal As Outlook.AppointmentItem
            Set olcal = FolderPartage.Items.Add
            olcal.Subject = "test"
            olcal.Start = Now
            olcal.Duration = 60    'durée de rdv, en minutes
            olcal.Save

  14. #14
    Candidat au Club
    Homme Profil pro
    Responsable de service informatique
    Inscrit en
    septembre 2017
    Messages
    9
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 35
    Localisation : France, Pyrénées Atlantiques (Aquitaine)

    Informations professionnelles :
    Activité : Responsable de service informatique
    Secteur : Enseignement

    Informations forums :
    Inscription : septembre 2017
    Messages : 9
    Points : 2
    Points
    2

    Par défaut

    Bonjour !

    Encore encore moi !

    Je n'ai pas encore eu l'occasion de tester pour les calendriers des collaborateurs, j'attends que le service informatique donne les droits à ma compagne sur les autres calendriers ...

    Par contre une autre question :

    Heure de visite 10h00
    Duree de la visite : 2 jours de travail soit 2 * 8h = 16h

    Si je fais avec la fonction durée il va me faire le rendez-vous de 10h00 à minuit puis ensuite le restant sur le lendemain or les les horaires des bureaux c'est 8h - 18h. Il faudrait donc qu'il me crée sur le premier jour de 10h00 à 18h avec la pause repas du midi soit 7h le premier jour puis ensuite 9h le lendemain de 8h à 18h avec la pause repas également.

    Comment faire pour lui intégrer des heures d'ouvertures de bureau ?

    Je sais je suis chiant avec mes questions ...

Discussions similaires

  1. [XL-2010] Création d'un rendez-vous dans un agenda Outlook partagé
    Par marwal dans le forum Macros et VBA Excel
    Réponses: 0
    Dernier message: 06/01/2014, 16h27
  2. Inscrire des rendez vous depuis un programme
    Par digitaldna dans le forum Outlook
    Réponses: 4
    Dernier message: 14/10/2010, 09h02
  3. [OL-2003] Erreur création d'un rendez-vous
    Par Fxnube dans le forum Outlook
    Réponses: 0
    Dernier message: 15/03/2010, 09h55
  4. Import de rendez-vous depuis fichier txt
    Par Joachim49 dans le forum VBA Outlook
    Réponses: 4
    Dernier message: 17/03/2009, 11h43
  5. [Outlook] Détecter la création d'un rendez-vous
    Par s.n.a.f.u dans le forum VB.NET
    Réponses: 1
    Dernier message: 20/02/2007, 12h23

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo