Extraire un email en fonction d'un domaine précis (VBA)

Bonjour,

Je cherche un moyen d'extraire dans Excel, toutes les adresses email des contacts d'une liste de diffusion donné depuis une liste d'adresse email globale sur Outlook (Microsoft Exchange).

Je cherche à extraire les adresses emails qui commencent par smtp: et qui se terminent par un domaine spécifique @outlook.com ou @MonEntreprise.fr (par exemple). Le tout, dans un tableau excel pour traiter ces données.

J'ai trouvé l'endroit où l'on peut voir ces adresses emails dans la fiche d'un contact depuis Outlook (voir ci-dessous, encadré rouge).

S'il y a besoin que Outlook soit ouvert sur le PC en même temps que mon fichier excel pour exécuter la procédure ce n'est pas une problématique. Toutefois, si cela est plus simple de réaliser cette extraction avec l'utilisateur titulaire du compte de messagerie en cours d'utilisation je suis aussi preneur

Je vous remercie d'avance pour votre aide,

A votre disposition si vous avez besoin de plus de précisions

Baptiste K.

Bonjour,

Un essai sans tenir compte du début "smtp".

Recherche dans les Contacts du Microsoft Outlook ouvert en arrière plan...

En exemple : domaine "hotmail.com" et début de l'écriture en "G1" de la feuille active.

Option Explicit

Public Sub ListeDiffusion()

  Dim i As Integer, j As Integer, X As Integer, y As Integer
  Dim myOlApp As Outlook.Application
  Dim myOlNmp As Outlook.Namespace
  Dim myOlLst As Outlook.Items

  Set myOlApp = New Outlook.Application
  Set myOlNmp = myOlApp.GetNamespace("MAPI")
  Set myOlLst = myOlNmp.GetDefaultFolder(olFolderContacts).Items

  For i = 1 To myOlLst.Count
    If TypeName(myOlLst.Item(i)) = "DistListItem" Then

      'Lister les adresses mail associées à la liste de contact
      y = 1
      For j = 1 To myOlLst.Item(i).MemberCount
        X = InStr(myOlLst.Item(i).GetMember(j).Address, "@")
        If Right((myOlLst.Item(i).GetMember(j).Address), Len((myOlLst.Item(i).GetMember(j).Address)) - X) = "hotmail.com" Then
           ActiveSheet.Cells(y, "G") = myOlLst.Item(i).GetMember(j).Address
           y = y + 1
         End If
      Next j
    End If
  Next

  Set myOlLst = Nothing
  Set myOlNmp = Nothing
  Set myOlApp = Nothing

End Sub

ric

Bonjour ric,

Merci pour votre réponse. En ajoutant la liste de diffusion voulue à mes contacts la macro arrive à la trouver et l'écrit dans Excel.

Toutefois, le code m'a renvoyé l'alias de la Liste de Diffusion : nomdelaliste@domaine.fr.

Est-il plutôt possible que la macro renvoie tous les membres rattachés à cette liste de diffusion ?

On trouve notamment ces informations lorsque depuis le carnet d'adresses on fait : clic droit sur la liste de diffusion -> propriétés -> Général on trouve le ̂̂propriétaire de la liste ainsi que tous la liste des membres.

Enfin, est-il possible que la liste soit recherchée depuis le carnet d'adresse globale Exchange et non depuis la liste des contacts (offline) de Outlook ?

Merci d'avance pour ton aide.

Baptiste

Bonjour,

... Enfin, est-il possible que la liste soit recherchée depuis le carnet d'adresse globale Exchange et non depuis la liste des contacts (offline) de Outlook ? ...

Il m'est impossible de tester un carnet d'adresses global, je n'ai pas d'accès à un Outlook d'entreprise.

Désolé

Plus bas sur le lien que j'ai fourni dans mon autre message, l'on parle du code pour un serveur Exchange ...

ric

Bonjour

Effectivement il y a ce code :

Option Explicit

'Lister les contacts du carnet d'adresses
Public Sub CarnetAdresses()

  Dim i As Long
  Dim myOlApp As Outlook.Application
  Dim myOlNmp As Outlook.Namespace
  Dim myOlLst As Outlook.AddressList
  Dim myOlDst As Outlook.ExchangeDistributionList

  Set myOlApp = New Outlook.Application
  Set myOlNmp = myOlApp.GetNamespace("MAPI")
  Set myOlLst = myOlNmp.AddressLists("Liste d'adresses globale")

  For i = 1 To myOlLst.AddressEntries.Count

    If myOlLst.AddressEntries.Item(i).AddressEntryUserType = olExchangeDistributionListAddressEntry Then
      Set myOlDst = myOlLst.AddressEntries.Item(i).GetExchangeDistributionList
      Debug.Print (myOlDst.Name)
    End If

  Next i

  Set myOlApp = Nothing

End Sub

Ainsi que celui-ci où j'ai modifié le dossier à rechercher (toutes les listes de distribution)

Option Explicit

'Lister les listes de diffusion
Public Sub CarnetAdresses()

  Dim i As Long
  Dim myOlApp As Outlook.Application
  Dim myOlNmp As Outlook.Namespace
  Dim myOlLst As Outlook.AddressList

  Set myOlApp = New Outlook.Application
  Set myOlNmp = myOlApp.GetNamespace("MAPI")
  Set myOlLst = myOlNmp.AddressLists("Toutes les listes de distribution")

  For i = 1 To myOlLst.AddressEntries.Count
    Debug.Print (myOlLst.AddressEntries.Item(i).Name)
  Next i

  Set myOlApp = Nothing

End Sub

Je l'ai mis dans un module puis je l'ai exécuté.. mais le temps de réponse est extrêmement long. Je vois dans ce code, une fois exécuté, comment il indique toutes les listes de diffusion à l'utilisateur : il implémente aucunes cellules de Excel.

Il ne serait pas possible avec ce code de définir le nom de la liste de diffusion à rechercher ? Au final ça serait une compilation entre le code que tu m'avais fournit dans ton premier message et celui ci-dessus ?

Baptiste.

Bonjour,

Pour écrire dans une feuille Excel (ton dernier code ) ...

Il faut remplacer ...

  For i = 1 To myOlLst.AddressEntries.Count
    Debug.Print (myOlLst.AddressEntries.Item(i).Name)
  Next i

Par

 Dim Y As Integer  ' << ajout
   Y = 1 ' << ajout
  For i = 1 To myOlLst.AddressEntries.Count
     ActiveSheet.Cells(Y, "G") = myOlLst.AddressEntries.Item(i).Name ' << modif
      Y = Y + 1  ' << ajout
  Next i

Pour le reste, je ne peux malheureusement pas t'aider.

ric

Bonjour Ric

Du coup ça fonctionne merci pour ta précieuse aide ! Le code me liste dans le fichier excel toutes les listes de diffusions du serveur exchange. Ça prend beaucoup de temps car il y en un paquet

Du coup je vais certainement ouvrir un nouveau sujet pour l'extraction des membres d'une liste de diffusion donnée, question un peu hors sujet ici

Merci encore,

Baptiste