XL 2010 Extraitre les informations d'une liste de distribution Exchange

[fablog]

Bonjour tout le monde,

Depuis plusieurs mois je suis à la recherche d'une macro VBA qui me permettrait d'extraire toutes les informations d'une liste de distribution (email) Exchange vers Excel. J'ai trouvé hier ce code mais, n'ayant pas de formation VBA, je ne sais pas comment l'utiliser ou la modifier:

Const olFolderContacts = 10
Sub DistList()
    Dim objApp As Object, objNS As Object
    Dim objFolder As Object, objDist As Object
    Dim objAddrEntry As Object
    Dim MyList As String
    Dim ws As Worksheet
   
    Set ws = ActiveWorkbook.Worksheets.Add
   
    MyList = "MyList" ' change your list  name here
    Set objApp = CreateObject("Outlook.Application")
    Set objNS = objApp.GetNamespace("MAPI")
    Set objFolder = objNS.GetDefaultFolder(olFolderContacts)
    On Error Resume Next
    Set objDist = objFolder.Items(MyList)
    On Error GoTo 0
    If objDist Is Nothing Then
        MsgBox "Distribution List doesn't exist", vbCritical
        GoTo fastexit
    End If
   
    For i = 1 To objDist.MemberCount
        Set objAddrEntry = objDist.GetMember(i).AddressEntry
        Cells(i, 1) = objAddrEntry.Name
        Cells(i, 2) = objAddrEntry.Address
    Next
fastexit:
    Set objFolder = Nothing
    Set objApp = Nothing
End Sub

J'ai besoin principalement, d'extraire périodiquement dans Excel les noms des personnes qui sont inclus dans mes listes de distribution. Pourriez-vous me conseiller sur son utilisation ou m'indiquer un meilleur code svp?

Merci et bonne journée!

 

[gosselien]

Bonjour,

Tu ouvres un fichier excel; tu appuies sur ALT-F11 / Insertion / Module pour insérer un module VBA, tu y colles ce code.
Si tu as Outlook (je viens de tester avec Outlook 2007), tu devra avoir au préalable créé une liste de distribution avec des mails et noms de personnes (c'est indiqué dansl'aide)
Dans le code "MyList = "MyList" ' change your list name here" tu changes Mylist par le nom de ta liste
Depuis excel, tu lanceras la macro par : soir F8 pour du pas à pas ou F5 pour vitesse normale et c'est tout.

P.

 

[fablog]

Bonjour Gosselien,

J'avais déjà essayé et cela me donne une fenetre d'erreur indiquant:"Distribution List doesn't exist" !?

 

[gosselien]

moi aussi , il m'a donné ce message avant que je ne change soit le nom de la liste dans Outlook , soit dans Excel
Si tes listes s'appellent "cadres" "employés" " salariés" et que tu veux la liste des cadres dans excel avec ce code tu changes:
----
"MyList = "cadres"
----
c'est tout, j'ai testé ici et ça a été du premier coup et je ne fais JAMAIS ça

P.

 

[fablog]

Je ne pourrai pas changer le nom des listes qui sont sur le serveur Exchange de mon organisation, je n'ai pas ce droit d'accès. J'ai essayé de mettre l'adresse au complet de la liste (ex: exemple@exemple.net) et j'ai le même message.

 

[gosselien]

Ok , mais ces listes ont bien un nom, c'est ça qu'il faut trouver j'imagine
Je ne sais pas en faire + pour toi, sorry

P.

 

[fablog]

Le seul nom qui existe serait "exemple" si je reprends l'adresse du groupe de distribution "exemple@exemple.net". J'ai déjà essayé sans succès. Merci quand même gosselien

J'ai trouvé cet autre morceau de code, que je comprends encore moins et qui ne fonctionne pas plus car je ne sais pas quoi modifier

Sub ListGAL()
    On Error Resume Next
    Const LogFile = "C:\Test\OLK_GAL.log"
    Const sSCHEMA = "http://schemas.microsoft.com/mapi/proptag/0x"
    Const PR_EMS_AB_PROXY_ADDRESSES = &H800F101E

    Dim oNameSpace As Namespace, oGAL As AddressList, oEntry As AddressEntry
    Dim oFSO As Variant, oLF As Variant, oExUser As ExchangeUser, i As Long

    ' Oulook objects
    Set oNameSpace = Outlook.Application.GetNamespace("MAPI")
    ' Global Address List object
    Set oGAL = oNameSpace.AddressLists("Global Address List")
    '----------
    ' Log file objects
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set oLF = oFSO.CreateTextFile(LogFile)
    '----------
    For Each oEntry In oGAL.AddressEntries
        i = i + 1
        Debug.Print i & vbTab & oEntry.Name
        If oEntry.AddressEntryUserType = olExchangeUserAddressEntry Then
            oLF.WriteLine "Entry " & i & " (olExchangeUserAddressEntry)"
            oLF.WriteLine "Name: " & oEntry.Name
            oLF.WriteLine "Address: " & oEntry.Address
            Set oExUser = oEntry.GetExchangeUser
            ' SMTP ADDRESSES
            oLF.WriteLine "SMTP Addresses:"
            oLF.WriteLine vbTab & Join(oExUser.PropertyAccessor.GetProperty(sSCHEMA & Hex(PR_EMS_AB_PROXY_ADDRESSES)), vbCrLf & vbTab)
            Set oExUser = Nothing
            oLF.WriteLine String(50, Chr(151)) ' Separator
        End If
    Next
    '----------
    ' Close Log File, clean up
    oLF.Close
    Set oGAL = Nothing
    Set oNameSpace = Nothing
    Set oLF = Nothing
    Set oFSO = Nothing
End Sub