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
    Expert éminent
    Carnet d'adresse Global : Récupérer la liste des Adresses de messagerie
    Bonjour,

    Je cherche à récupérer les différentes adresses de messagerie qui pointent sur une même boîte mail.

    En gros, le SMTP principal et les smtp secondaires

    On peut les consulter en faisant un clic-droit sur le contact >> Propriété >> Adresses de messagerie

    Après avoir épluché les propriétés offertes, je n'ai pas trouvé mon bonheur


  2. #2
    Expert éminent
    Salut,
    c'est cadeau
    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
    Sub GetAliasFromdefaultuser()
    '---------------------------------------------------------------------------------------
    ' Procedure : GetAliasFromRecipient
    ' Author    : Oliv
    ' Date      : 22/11/2018
    ' Purpose   :
    '---------------------------------------------------------------------------------------
    '
        Dim myOlApp
        Dim Dest, AliasArray, i
        On Error Resume Next
        If StrComp(Application, "Outlook", vbTextCompare) = 0 Then
            Set myOlApp = Application
        Else
            Set myOlApp = CreateObject("outlook.application")
        End If
     
        Set Dest = myOlApp.Session.currentuser
        Dim exc: Set exc = Dest.AddressEntry.GetExchangeUser
        Const PR_EMS_AB_PROXY_ADDRESSES = "http://schemas.microsoft.com/mapi/proptag/0x800F101F"
        AliasArray = Dest.AddressEntry.propertyAccessor.GetProperty(PR_EMS_AB_PROXY_ADDRESSES)
        Set Wk = Application.Workbooks.Add
        Set WS = Wk.ActiveSheet
        WS.Cells(1, 1).Value = "ALIAS"
        For i = 0 To UBound(AliasArray) - 1
            WS.Cells(i + 2, 1).Value = Split(AliasArray(i), ":")(1)
        Next i
     
        WS.Cells(1, 3).Value = "PRIMARYSMTP"
        WS.Cells(2, 3).Value = exc.PrimarySmtpAddress
     
    End Sub

  3. #3
    Expert éminent
    Salut,

    ah ! Merci, j'ai toujours du mal à trouver la PropTag qui va bien

    J'ai adapté à mon besoin : boucler sur le carnet d'adresse globale et extraire les alias

    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
    Sub GetAliasFromGlobalAddressEntry()
        Dim myOlApp As Object
        Dim AliasArray
        Dim i As Long, j As Long
        Dim AllGal As Object, Exc As Object, Dest As Object
        Dim Wb As Workbook, Ws As Worksheet
     
        Const PR_EMS_AB_PROXY_ADDRESSES = "http://schemas.microsoft.com/mapi/proptag/0x800F101F"
     
        On Error Resume Next
        If StrComp(Application, "Outlook", vbTextCompare) = 0 Then
            Set myOlApp = Application
        Else
            Set myOlApp = CreateObject("outlook.application")
        End If
     
        Set AllGal = myOlApp.Session.GetGlobalAddressList().AddressEntries
        With Application.Workbooks.Add
            With .ActiveSheet
                .Cells(1, 1).Value = "Adresse Principale"
     
                For i = 1 To AllGal.Count
                    Set Dest = AllGal.Item(i)
                    Set Exc = Dest.GetExchangeUser
                    AliasArray = Dest.propertyAccessor.GetProperty(PR_EMS_AB_PROXY_ADDRESSES)
     
                    .Cells(i + 1, 1).Value = Exc.PrimarySmtpAddress
     
                    For j = 0 To UBound(AliasArray) - 1
                        .Cells(i + 1, j + 2).Value = Split(AliasArray(j), ":")(1)
                    Next j
                Next i
     
                .Cells(1, 2).Resize(1, .UsedRange.Columns.Count - 1).Value = "ALIAS"
            End With
        End With
    End Sub