Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

  1. #1
    Futur Membre du Club
    Homme Profil pro
    employé
    Inscrit en
    mai 2018
    Messages
    17
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 36
    Localisation : Belgique

    Informations professionnelles :
    Activité : employé

    Informations forums :
    Inscription : mai 2018
    Messages : 17
    Points : 5
    Points
    5

    Par défaut Problème import des rendez-vous outlook dans Excel

    Bonjour la communauté,
    je viens vers vous car je rencontre un soucis avec une macro réalisé grâce à votre aide .
    La macro permet d'importer les rendez-vous entre la date séléctionnée et les 15 jours qui suivent .
    Le soucis est qu'elle fonctionne parfaitement pour les agendas de mes collègues que je souhaite consulter , mais je rencontre une erreur avec moon propre agenda
    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
     
    Private Sub CommandButton5_Click()
     
     
    ActiveWorkbook.Sheets("Sheet2").Select
    Cells(1, 1) = DTPicker1
     
     Dim olApp As New Outlook.Application
     Dim namespaceOutlook As Namespace, RDV, DateDeb As Date, DateFin As Date
     Dim memoire As String
     Dim cell As Range
     Dim DossierCalendrier As Outlook.MAPIFolder
     DateDeb = DTPicker1
     DateFin = DTPicker1 + 15
     Set olApp = Outlook.Application
     Set namespaceOutlook = olApp.GetNamespace("MAPI")
     Set DossierCalendrier = Get_Calendrier_partagé(ListBox2.Column(1))
     Set RDV = _
     DossierCalendrier
     On Error GoTo Err_Execution
     For Each Item In RDV.Items
     
     If Item.Start >= DateDeb And Item.End <= DateFin Then
        ActiveWorkbook.Sheets("TEMPRDV").Select
        Range("A" & Range("A" & Cells.Rows.Count).End(xlUp).Row + 1).Select
        ActiveCell.Value = Item.Start
        Range("B" & Range("B" & Cells.Rows.Count).End(xlUp).Row + 1).Select
        ActiveCell.Value = "- " & Item.Location
        Range("C" & Range("C" & Cells.Rows.Count).End(xlUp).Row + 1).Select
        ActiveCell.Value = Item.Subject
        Range("D" & Range("D" & Cells.Rows.Count).End(xlUp).Row + 1).Select
        ActiveCell.Value = Item.Duration
     
     End If
     Next
     
     ActiveWorkbook.Worksheets("TEMPRDV").Sort.SortFields.Clear
        ActiveWorkbook.Worksheets("TEMPRDV").Sort.SortFields.Add Key:=Range("A2"), _
            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With ActiveWorkbook.Worksheets("TEMPRDV").Sort
            .SetRange Range("A2:E100")
            .Header = xlNo
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        'For Each cell In ThisWorkbook.Sheets("Base").Range("A11:BC35")
            'memoire = memoire & cell.Value & vbNewLine
        'Next
     
     
     
     
     UserForm5.Show
     
       Sheets("TEMPRDV").Select
    Range("A2:D50").Clear
    Exit Sub
    Err_Execution:
    MsgBox "vous n'avez accés à cet agenda"
    Exit Sub
     
     
     
     End Sub
    Merci d'avance pour votre aide !

    Goth!er

  2. #2
    Futur Membre du Club
    Homme Profil pro
    employé
    Inscrit en
    mai 2018
    Messages
    17
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 36
    Localisation : Belgique

    Informations professionnelles :
    Activité : employé

    Informations forums :
    Inscription : mai 2018
    Messages : 17
    Points : 5
    Points
    5

    Par défaut message d'erreur

    re,

    J'ai oublié de préciser le message d'erreur : Object doesn't support this property or method .

    voilà .

    Goth!er

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

    Informations professionnelles :
    Activité : solution provider

    Informations forums :
    Inscription : mars 2006
    Messages : 3 601
    Points : 6 230
    Points
    6 230
    Billets dans le blog
    16

    Par défaut

    Bonjour,
    il faut tester si le choix dans le menu déroulant = utilisateur courant

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    Application.Session.CurrentUser.Name
    si oui on change

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    Set DossierCalendrier = Get_Calendrier_partagé(ListBox2.Column(1))
    par
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    Set DossierCalendrier = namespaceOutlook.GetDefaultFolder(olFolderCalendar )

  4. #4
    Futur Membre du Club
    Homme Profil pro
    employé
    Inscrit en
    mai 2018
    Messages
    17
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 36
    Localisation : Belgique

    Informations professionnelles :
    Activité : employé

    Informations forums :
    Inscription : mai 2018
    Messages : 17
    Points : 5
    Points
    5

    Par défaut

    Merci déjà @Oliv- pour ta réponse .

    j'ai tenté comme ceci mais le test de condition ne fonctionne pas de cette manièr:
    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
     If ListBox2.Column(1) = Application.Session.CurrentUser.Name Then
     Set olApp = Outlook.Application
     Set namespaceOutlook = olApp.GetNamespace("MAPI")
     Set DossierCalendrier = namespaceOutlook.GetDefaultFolder(olFolderCalendar)
     Set RDV = _
     DossierCalendrier
     
    Else
     
     Set olApp = Outlook.Application
     Set namespaceOutlook = olApp.GetNamespace("MAPI")
     Set DossierCalendrier = Get_Calendrier_partagé(ListBox2.Column(1))
     Set RDV = _
     DossierCalendrier
     
     End If
    j'ai une erreur sur :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    If ListBox2.Column(1) = Application.Session.CurrentUser.Name Then
    Goth!er

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

    Informations professionnelles :
    Activité : solution provider

    Informations forums :
    Inscription : mars 2006
    Messages : 3 601
    Points : 6 230
    Points
    6 230
    Billets dans le blog
    16

    Par défaut

    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
     
     Set olApp = Outlook.Application
     Set namespaceOutlook = olApp.GetNamespace("MAPI")
    If ListBox2.Column(1) = namespaceOutlook.CurrentUser.Name Then
     Set DossierCalendrier = namespaceOutlook.GetDefaultFolder(olFolderCalendar)
     Set RDV = _
     DossierCalendrier
     
    Else
     
     
     Set DossierCalendrier = Get_Calendrier_partagé(ListBox2.Column(1))
     Set RDV = _
     DossierCalendrier
     
     End If

  6. #6
    Futur Membre du Club
    Homme Profil pro
    employé
    Inscrit en
    mai 2018
    Messages
    17
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 36
    Localisation : Belgique

    Informations professionnelles :
    Activité : employé

    Informations forums :
    Inscription : mai 2018
    Messages : 17
    Points : 5
    Points
    5

    Par défaut

    Oliv- ,
    J'obtiens toujours le message d'erreur :
    Object does'nt support this property or method


    Goth!er

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

    Informations professionnelles :
    Activité : solution provider

    Informations forums :
    Inscription : mars 2006
    Messages : 3 601
    Points : 6 230
    Points
    6 230
    Billets dans le blog
    16

    Par défaut

    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
     
     Set olApp = Outlook.Application
     Set namespaceOutlook = olApp.GetNamespace("MAPI")
    If ListBox2.Column(1) = olapp. Session.CurrentUser.Name Then
     Set DossierCalendrier = namespaceOutlook.GetDefaultFolder(olFolderCalendar)
     Set RDV = _
     DossierCalendrier
     
    Else
     
     
     Set DossierCalendrier = Get_Calendrier_partagé(ListBox2.Column(1))
     Set RDV = _
     DossierCalendrier
     
     End If

  8. #8
    Futur Membre du Club
    Homme Profil pro
    employé
    Inscrit en
    mai 2018
    Messages
    17
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 36
    Localisation : Belgique

    Informations professionnelles :
    Activité : employé

    Informations forums :
    Inscription : mai 2018
    Messages : 17
    Points : 5
    Points
    5

    Par défaut

    Meme résultat ... un vrai casse tête ...

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

    Informations professionnelles :
    Activité : solution provider

    Informations forums :
    Inscription : mars 2006
    Messages : 3 601
    Points : 6 230
    Points
    6 230
    Billets dans le blog
    16

    Par défaut

    Sur quelle ligne se produit l'erreur ?

    VOIR : https://www.developpez.net/forums/bl.../debogage-vba/

  10. #10
    Futur Membre du Club
    Homme Profil pro
    employé
    Inscrit en
    mai 2018
    Messages
    17
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 36
    Localisation : Belgique

    Informations professionnelles :
    Activité : employé

    Informations forums :
    Inscription : mai 2018
    Messages : 17
    Points : 5
    Points
    5

    Par défaut la fonction ?

    Bien vu ! il n'y a pas d'erreur en tant que tel .. mais du coup je vois que la macro renvoie vers une fonction ( je pense même que tu en es l'auteur...) :
    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
    Function Get_Calendrier_partagé(Nom) As Outlook.Folder
        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(Nom)
     
        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
            Set Get_Calendrier_partagé = FolderPartage
            ' MsgBox myrecipient & vbCr & FolderPartage, , "Accès autorisé à "
        End If
    End Function
    Est-il possible d'ajouter une condition dans la fonction , car je vois que du coup la fonction concernait les calendrier partagé uniquement ?

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

    Informations professionnelles :
    Activité : solution provider

    Informations forums :
    Inscription : mars 2006
    Messages : 3 601
    Points : 6 230
    Points
    6 230
    Billets dans le blog
    16

    Par défaut

    Essaye ceomme cela


    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
     
     Set olApp = Outlook.Application
     Set namespaceOutlook = olApp.GetNamespace("MAPI")
    If strcomp(ListBox2.Column(1) ,olapp. Session.CurrentUser.Name,vbTextCompare) = 0  Then
     Set DossierCalendrier = namespaceOutlook.GetDefaultFolder(olFolderCalendar)
     Set RDV = _
     DossierCalendrier
     
    Else
     
     
     Set DossierCalendrier = Get_Calendrier_partagé(ListBox2.Column(1))
     Set RDV = _
     DossierCalendrier
     
     End If

  12. #12
    Futur Membre du Club
    Homme Profil pro
    employé
    Inscrit en
    mai 2018
    Messages
    17
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 36
    Localisation : Belgique

    Informations professionnelles :
    Activité : employé

    Informations forums :
    Inscription : mai 2018
    Messages : 17
    Points : 5
    Points
    5

    Par défaut

    je pense que je viens de trouver une partie du problème !
    Ma ListBox2.column(1) = adresse mail
    olApp.Session .CurrentUser.Name = NOM Prénom

    du coup, on ne remplie pas la condition

    Goth!er

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

    Informations professionnelles :
    Activité : solution provider

    Informations forums :
    Inscription : mars 2006
    Messages : 3 601
    Points : 6 230
    Points
    6 230
    Billets dans le blog
    16

    Par défaut

    avec cela alors

    namespaceOutlook.Accounts.Item(1).SmtpAddress

  14. #14
    Futur Membre du Club
    Homme Profil pro
    employé
    Inscrit en
    mai 2018
    Messages
    17
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 36
    Localisation : Belgique

    Informations professionnelles :
    Activité : employé

    Informations forums :
    Inscription : mai 2018
    Messages : 17
    Points : 5
    Points
    5

    Par défaut On progresse...

    Avec cela, on avance, il y a bien un respect de la condition ... mais la suite du code n'importe rien :
    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
     
    Private Sub CommandButton5_Click()
     
     
    ActiveWorkbook.Sheets("Sheet2").Select
    Cells(1, 1) = DTPicker1
     
     Dim olApp As New Outlook.Application
     Dim namespaceOutlook As Namespace, RDV, DateDeb As Date, DateFin As Date
     Dim memoire As String
     Dim cell As Range
     Dim DossierCalendrier As Outlook.MAPIFolder
     DateDeb = DTPicker1
     DateFin = DTPicker1 + 15
     Set olApp = Outlook.Application
     Set namespaceOutlook = olApp.GetNamespace("MAPI")
     Set olApp = Outlook.Application
     Set namespaceOutlook = olApp.GetNamespace("MAPI")
    If ListBox2.Column(1) = namespaceOutlook.Accounts.Item(1).SmtpAddress Then
     Set DossierCalendrier = namespaceOutlook.GetDefaultFolder(olFolderCalendar)
     Set RDV = _
     DossierCalendrier
     
    Else
     
     
     Set DossierCalendrier = Get_Calendrier_partagé(ListBox2.Column(1))
     Set RDV = _
     DossierCalendrier
     
     End If
     
     
     On Error GoTo Err_Execution
     For Each Item In RDV.Items
     
     If Item.Start >= DateDeb And Item.End <= DateFin Then
        ActiveWorkbook.Sheets("TEMPRDV").Select
        Range("A" & Range("A" & Cells.Rows.Count).End(xlUp).Row + 1).Select
        ActiveCell.Value = Item.Start
        Range("B" & Range("B" & Cells.Rows.Count).End(xlUp).Row + 1).Select
        ActiveCell.Value = "- " & Item.Location
        Range("C" & Range("C" & Cells.Rows.Count).End(xlUp).Row + 1).Select
        ActiveCell.Value = Item.Subject
        Range("D" & Range("D" & Cells.Rows.Count).End(xlUp).Row + 1).Select
        ActiveCell.Value = Item.Duration
     
     End If
     Next
     
     ActiveWorkbook.Worksheets("TEMPRDV").Sort.SortFields.Clear
        ActiveWorkbook.Worksheets("TEMPRDV").Sort.SortFields.Add Key:=Range("A2"), _
            SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With ActiveWorkbook.Worksheets("TEMPRDV").Sort
            .SetRange Range("A2:E100")
            .Header = xlNo
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        'For Each cell In ThisWorkbook.Sheets("Base").Range("A11:BC35")
            'memoire = memoire & cell.Value & vbNewLine
        'Next
     
     
     
     
     UserForm5.Show
     
       Sheets("TEMPRDV").Select
    Range("A2:D50").Clear
    Exit Sub
    Err_Execution:
    MsgBox "vous n'avez pas accés à cet agenda" & Err.Description, vbExclamation
     
    Exit Sub
     
     
     
     End Sub
    j'obtiens toujours le meme resultat , la MsgBox s'affiche avec le message la description d'erreur : Object doesn't support this property or method .

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

    Informations professionnelles :
    Activité : solution provider

    Informations forums :
    Inscription : mars 2006
    Messages : 3 601
    Points : 6 230
    Points
    6 230
    Billets dans le blog
    16

    Par défaut

    En fait il y a plusieurs pb dans ton code
    notamment d'autres types d'éléments peuvent être dans un dossier calendrier (comme des emails, des contacts, des meetings,)

    Voici ma correction

    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
     
    Private Sub CommandButton5_Click()
     
     
        ActiveWorkbook.Sheets("Sheet2").Select
        Cells(1, 1) = DTPicker1
     
        Dim olApp As New Outlook.Application
        Dim namespaceOutlook As Namespace, RDV, DateDeb As Date, DateFin As Date
        Dim memoire As String
        Dim cell As Range
        Dim DossierCalendrier As Outlook.MAPIFolder
        DateDeb = DTPicker1
        DateFin = DTPicker1 + 15
        Set olApp = Outlook.Application
        Set namespaceOutlook = olApp.GetNamespace("MAPI")
     
        'Oliv
        If ListBox2.ListIndex = -1 Then Exit Sub    '= pas de selection
     
     
        If StrComp(ListBox2.Column(1), namespaceOutlook.Accounts.Item(1).SmtpAddress, vbTextCompare) = 0 Then
            Set DossierCalendrier = namespaceOutlook.GetDefaultFolder(olFolderCalendar)
            Set RDV = _
                    DossierCalendrier
     
        Else
     
     
            Set DossierCalendrier = Get_Calendrier_partagé(ListBox2.Column(1))
            Set RDV = _
                    DossierCalendrier
     
        End If
     
     
        ' On Error GoTo Err_Execution
        For Each Item In RDV.Items
     
            'Oliv il peut y avoir autre chose que des rdv dans les dossiers calendriers
            If Item.Class = olAppointment Then
     
                If Item.Start >= DateDeb And Item.End <= DateFin Then
                    With ActiveWorkbook.Sheets("TEMPRDV")
     
                        'attention avec ton ancienne méthode situ as des cellules vides tu peux décaler le résulta
                        ligneVide = .Range("A" & .Cells.Rows.Count).End(xlUp).Row + 1
     
                        .Range("A" & ligneVide).Value = Item.Start
                        .Range("B" & ligneVide).Value = "- " & Item.Location
                        .Range("C" & ligneVide).Value = Item.Subject
                        .Range("D" & ligneVide).Value = Item.Duration
                    End With
                End If
            End If
        Next
     
        ActiveWorkbook.Worksheets("TEMPRDV").Sort.SortFields.Clear
        ActiveWorkbook.Worksheets("TEMPRDV").Sort.SortFields.Add Key:=Range("A2"), _
                SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        With ActiveWorkbook.Worksheets("TEMPRDV").Sort
            .SetRange Range("A2:E100")
            .Header = xlNo
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            .Apply
        End With
        'For Each cell In ThisWorkbook.Sheets("Base").Range("A11:BC35")
        'memoire = memoire & cell.Value & vbNewLine
        'Next
     
     
     
     
        UserForm5.Show
     
        Sheets("TEMPRDV").Select
        Range("A2:D50").Clear
        Exit Sub
    Err_Execution:
        MsgBox "vous n'avez pas accés à cet agenda" & Err.Description, vbExclamation
     
        Exit Sub
     
     
     
    End Sub
     
    Function Get_Calendrier_partagé(Nom) As Outlook.Folder
        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(Nom)
     
        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
            Set Get_Calendrier_partagé = FolderPartage
            ' MsgBox myrecipient & vbCr & FolderPartage, , "Accès autorisé à "
        End If
    End Function

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. Import de rendez-vous Outlook dans Access
    Par pascal@falcy.ch dans le forum VBA Access
    Réponses: 17
    Dernier message: 30/01/2015, 10h21
  2. Réponses: 0
    Dernier message: 29/12/2011, 09h53
  3. [OL-2007] Rendez-vous outlook vers excel
    Par demouret dans le forum VBA Outlook
    Réponses: 13
    Dernier message: 26/04/2011, 11h11
  4. importer des image qui sont dans excel dans une table SQL2005
    Par johanaquatique dans le forum MS SQL Server
    Réponses: 3
    Dernier message: 31/08/2009, 18h13
  5. lier rendez vous outlook dans formulaire access
    Par TAUPE007 dans le forum Access
    Réponses: 0
    Dernier message: 11/05/2008, 13h56

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