VBA - Recherche liste de mail dans Outlook

Bens7

XLDnaute Impliqué
Bonjour a tous !
J'ai une requette qui pourrais me faire gagner un temp fou !
J'ai une liste de mail dans mon tableau (collone AA).
Je souhaiterais un macro qui en clikant recherché dans mon outlook et m'ouvre tous les mails recu de la liste, s'y il n'y en a pas ... passé au suivant, s'y il en a plusieurs de la meme adresse les ouvre tous ...

Je suis desole mais etant novice j'ai rechercher sans success!
Merci vraiment urgent 2000 mail a verifier un par un ....:( (je ferais 20 par 20 pour pas trop alourdire)
 

Yaloo

XLDnaute Barbatruc
Re : VBA - Recherche liste de mail dans Outlook

Bonsoir Bens,

Voici un fichier où je t'ai mis 2 possibilités dans 2 onglets différents.
- Soit, comme tu le souhaites, ouverture de tous les mails des adresses dans la colonne A
- Soit en changeant la valeur de la cellule A1

Dans les 2 cas, il suffit d'ajouter les adresses mail sous les autres, j'ai créé une liste.

A+

Martial
 

Pièces jointes

  • Ouvrir mail Outlook avec Excel.xlsm
    25.1 KB · Affichages: 78

Bens7

XLDnaute Impliqué
Re : VBA - Recherche liste de mail dans Outlook

Erreur Projet ou Biblihoteque introuvable [liste Adresse]
dand le command buton 1
P.S merci beaucoup pour ta reactivite !
PS2 : je prefere l'onglet 1 avec l liste plus Adapter mais m collone de mail est en AA , je trouverais le changement je penssr
 

Antoine C.

XLDnaute Nouveau
Bonjour,

Je Up! le sujet. Il date de 2015, et me serait bien utile... En tout cas la partie de recherche.
J'ai download le fichier, mais il ne se passe absolument rien au clic. J'ai regardé le code et je suis dans l'incapacité de comprendre ce qui ne marche pas.
Je suis en Office 365

Merci pour votre aide.

VB:
Option Explicit
'La boite de réception, la boite des éléments supprimés et tous leurs
'sous dossiers sont pris en compte.
Sub ExportePiecesJointes(Adresse$)
Dim Ol As New Outlook.Application
Dim Ns As Outlook.Namespace
Dim Dossier As Outlook.MAPIFolder
 
  Set Ns = Ol.GetNamespace("MAPI")
  Set Dossier = Ns.Folders(1)
 
  SearchFolders Dossier, Adresse
End Sub
Private Sub SearchFolders(ByVal Fld As Outlook.MAPIFolder, Adresse$)
Dim y As Integer, nom$, Email$
Dim OLmail As Outlook.MailItem
Dim pceJointe As Outlook.Attachment
Dim SousDossier As Outlook.MAPIFolder
Dim DossierArchives As Outlook.MAPIFolder
'Recherche les sous-répertoire dans ton dossier
For Each SousDossier In Fld.Folders
  'Si le sous-répertoire = "Pays"
  If SousDossier.DefaultItemType = 0 And SousDossier = "Boîte de réception" Then
    'On regarde dans tous les mails
    For Each OLmail In SousDossier.Items
      'Si l'adresse du mail correspond à A1
      If OLmail.SenderEmailAddress = Adresse Then
        'On récupère affiche le mail
        OLmail.Display
      End If
    'On passe au mail suivant
    Next OLmail
  End If
  'On passe au sous-répertoire suivant
  SearchFolders SousDossier, Adresse
Next SousDossier
End Sub
 

Antoine C.

XLDnaute Nouveau
Re,

EDIT avec le bon code fonctionnel

J'ai trouvé cela sur un forum, et fonctionnel. Il ne me reste plus qu'à mettre outlook en avant.

VB:
Sub SearchByAddress()
'---------------------------------------------------------------------------------------------------------------------
' Auteur : Oliv- adapté du code suivant http://www.slipstick.com/developer/instant-search-messages-selected-contact/
' Idée   : Trarc
' Date   : 23/06/2016
' OS_App : Win 8.1_OL-2007
' But    : Automatiser la commande "Rechercher tout/Message de l'expéd" pour trier rapidement les messages d'un dossier.
'---------------------------------------------------------------------------------------------------------------------
 
 'Vérifier l'ouverture de OUTLOOK :
     'Excel pratique par ouf746 » 26 janvier 2017, 15:08
       Dim oOutlook As Object
    
        On Error Resume Next
        Set oOutlook = GetObject(, "Outlook.Application")
        On Error GoTo 0
    
        If oOutlook Is Nothing Then
            Shell "Outlook.exe", vbHide
        End If
 '***
    
    Dim myOlApp As New outlook.Application
    Dim ns As outlook.Namespace
    Dim myOlExp As outlook.Explorer
    Dim myOlSel As outlook.Selection
 
    Dim txtSearch As String
 
    Set ns = myOlApp.GetNamespace("MAPI")
    Set myOlExp = myOlApp.ActiveExplorer
    Set myOlSel = myOlExp.Selection
 
    txtSearch = frmSaisie.txtEmail 'myOlSel.Item(1).SenderName
 
    myOlExp.Search txtSearch, olSearchScopeCurrentFolder
 
 'Mettre OUTLOOK devant
    'Excel pratique par fred2406 » 16 février 2018, 18:55
    outlook.ActiveWindow.WindowState = 0
 
    Set myOlApp = Nothing
    Set myOlExp = Nothing
    Set myOlSel = Nothing
 
End Sub
 
Dernière édition:

Discussions similaires

Réponses
1
Affichages
2 K
Compte Supprimé 979
C

Statistiques des forums

Discussions
314 611
Messages
2 111 144
Membres
111 051
dernier inscrit
MANUREVALAND