Discussion :

[goninph]

Bonjour,

J'ai trouvé ce code sur internet, mais il ne fonctionne pas avec XL-365

J'aimerais lancer une recherche dans ma boite mail via Excel



Merci pour votre aide

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
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

[halaster08]

Bonjour,

Je pense que tu n'as pas activé la référence outlook
Dans l'interface vba dans le menu Outils -> reférence : coche la case microsoft outlook 16.0 object library

[goninph]

Avec ce code ça fonctionne

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Sub Recherche_Outlook()
Dim OutlookApp As Object
Dim Recherche As String
    Recherche = "espace"
    Set OutlookApp = CreateObject("Outlook.Application")
    OutlookApp.ActiveWindow.Activate
    OutlookApp.ActiveExplorer.Search Recherche, olSearchScopeAllFolders
    Set OutlookApp = Nothing
End Sub

[goninph]

Problème lorsque Option Explicit est actif

Comment déclarer la variable : olSearchScopeAllFolders

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
Option Explicit
Private Sub BT_Recherche_Outlook_Click()
Dim OutlookApp As Object
Dim Recherche As String
'Vérifier et ouvrir Outlook si pas ouvert
    On Error Resume Next
    Set OutlookApp = GetObject(, "Outlook.Application")
    On Error GoTo 0
    If OutlookApp Is Nothing Then
        Shell "Outlook.exe" ', vbHide
    End If
    Recherche = Cells(ActiveCell.Row, Range("TS_Suivi" & "[Cmde]").Column).Value
    Set OutlookApp = CreateObject("Outlook.Application")
    OutlookApp.ActiveWindow.Activate
    OutlookApp.ActiveExplorer.Search Recherche, olSearchScopeAllFolders
    Set OutlookApp = Nothing
End Sub

[Philippe Tulliez]

Bonjour,
olSearchScopeAllFolders est une constante Outlook elle est implicitement déclarée et a comme valeur 1.

[goninph]

Demande une déclaration



Par contre, en remplaçant par 0, c'est tout bon

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
Option Explicit
Private Sub BT_Recherche_Outlook_Click()
Dim OutlookApp As Object
Dim Recherche As String
'Vérifier et ouvrir Outlook si pas ouvert
    On Error Resume Next
    Set OutlookApp = GetObject(, "Outlook.Application")
    On Error GoTo 0
    If OutlookApp Is Nothing Then
        Shell "Outlook.exe" ', vbHide
    End If
    Recherche = Cells(ActiveCell.Row, Range("TS_Suivi" & "[Cmde]").Column).Value
    Set OutlookApp = CreateObject("Outlook.Application")
    OutlookApp.ActiveWindow.Activate
    OutlookApp.ActiveExplorer.Search Recherche, 0 'https://learn.microsoft.com/en-us/office/vba/api/outlook.olsearchscope
    Set OutlookApp = Nothing
End Sub

[goninph]

Autres détails

Le volet de la recherche reste ouvert, et je dois appuyer sur la touche Enter pour la fermer


J'aimerais inverser le tri des résultats

[Philippe Tulliez]

Bonjour,
Si le système indique variable non définie, cela signifie que la bibliothèque Outlook n'est pas référencée et que l'on est dans un cas de Late Binding
Il faut alors déclarer la variable ou une constante comme Byte, Integer ou Long avec comme valeur 1

[goninph]

OK

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
Private Sub BT_Recherche_Outlook_Click()
Dim OutlookApp As Object
Dim Recherche As String
Dim olSearchScope As Long
'Vérifier et ouvrir Outlook si pas ouvert
    On Error Resume Next
    Set OutlookApp = GetObject(, "Outlook.Application")
    On Error GoTo 0
    If OutlookApp Is Nothing Then
        Shell "Outlook.exe", vbMaximizedFocus  ', vbHide
    End If
    Recherche = "espace"
'    Recherche = Cells(ActiveCell.Row, Range("TS_Suivi" & "[Cmde]").Column).Value
    Set OutlookApp = CreateObject("Outlook.Application")
    OutlookApp.ActiveWindow.Activate
    olSearchScope = 0
    OutlookApp.ActiveExplorer.Search Recherche, olSearchScope 'https://learn.microsoft.com/en-us/office/vba/api/outlook.olsearchscope
    Set OutlookApp = Nothing
End Sub

[goninph]

Bonjour,

Le code fonctionne nickel, mais si je suis dans mon calendrier la recherche va s'effectuer dans le calendrier et de même si je suis dans les Tâches la recherche va s'effectuer dans les tâches

Comment choisir la boite de réception du compte p.gonin@zurbuchensa.ch pour effectuer la recherche ?

Je vous remercie pour votre aide 😘

[Philippe Tulliez]

Bonjour,

Comment choisir la boite de réception du compte p.gonin@zurbuchensa.ch pour effectuer la recherche ?

Le deuxième argument de la méthode Search indique où doit avoir lieu la recherche 1 (olSearchScopeAllFolders) c'est partout (voir l'illustration de ma réponse fil #5)

[goninph]

Oui, j'ai vu, mais quoique je fasse le problème persiste

Deplus si j'ai l'agenda d'un autre collaborateur est ouvert, la recherche va s'effectuer dans l'agenda du collaborateur

[Philippe Tulliez]

Bonjour,
Vous avez sans doute Exchange pour lequel je n'ai aucune compétence.

[goninph]

Personne à une idée ?

[goninph]

Bonjour,

Voilà ça fonctionne, la recherche s'ouvre dans une nouvelle fenêtre et le volet des dossiers sur la gauche est réduit ce qui laisse plus de place pour la lecture, coup de bol

Par contre, je n'arrive toujours pas à maximiser cette nouvelle fenêtre, un truc de fou

Merci pour votre aide

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
Private Sub BT_Recherche_Outlook_Click()
Dim objNS As Object
Dim objRecip As Object
Dim objFolder As Object
Dim Messagerie As Object
Dim Compte_Utilisateur As Variant
Dim Recherche As String
Dim Extension As String
Dim Position_du_Point As Long
    'Vérifier et ouvrir Outlook si pas ouvert
    On Error Resume Next
    Set Messagerie = GetObject(, "Outlook.Application")
    On Error GoTo 0
    If Messagerie Is Nothing Then
        Shell "Outlook.exe" ', vbHide
    End If
    'Fin de la vérification
    Compte_Utilisateur = "p.gonin@zurbuchensa.ch"
    Extension = Cells(ActiveCell.Row, Range("TS_Suivi" & "[Ext]").Column).Value
    If Extension = "fca01" Then
        Recherche = Cells(ActiveCell.Row, Range("TS_Suivi" & "[Cmde]").Column).Value & "." & Extension
    Else
        Position_du_Point = InStr(Extension, ".")
        If Position_du_Point = 0 Then
            Recherche = Cells(ActiveCell.Row, Range("TS_Suivi" & "[Cmde]").Column).Value & " " & Cells(ActiveCell.Row, Range("TS_Suivi" & "[Fournisseur]").Column).Value
        Else
            Recherche = Cells(ActiveCell.Row, Range("TS_Suivi" & "[Cmde]").Column).Value & "." & Right(Extension, Len(Extension) - Position_du_Point)
        End If
    End If
    Set Messagerie = CreateObject("Outlook.Application")
    Set objNS = Messagerie.GetNamespace("MAPI")
    On Error Resume Next    'permet de passer à la ligne suivante pour traiter l'erreur si le calendrier n'est pas trouvé
    Set objRecip = objNS.CreateRecipient(Compte_Utilisateur) '
    Set objFolder = objNS.GetSharedDefaultFolder(objRecip, 6)
                                                '(objRecip, 6) Mail
                                                '(objRecip, 9) Calendrier
                                                '(objRecip, 10) Contact
                                                '(objRecip, 11) Journal
                                                '(objRecip, 12) Notes
                                                '(objRecip, 13) Tâches
    objFolder.Display
    Messagerie.ActiveWindow.Activate
    Messagerie.ActiveExplorer.Search Recherche, 4
                                                '0 Dossier actuel
                                                '1 Toutes les boîtes aux lettres
                                                '2 Tous les éléments
                                                '3 Sous dossiers
                                                '4 Boîte aux lettres actuelle
                                                'https://learn.microsoft.com/en-us/office/vba/api/outlook.olsearchscope
    Set Messagerie = Nothing
    Unload Me
End Sub

[goninph]

Enfin !

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
Private Sub BT_Recherche_Outlook_Click()
Dim objNS As Object
Dim objRecip As Object
Dim objFolder As Object
Dim Messagerie As Object
Dim Compte_Utilisateur As Variant
Dim Recherche As String
Dim Extension As String
Dim Position_du_Point As Long
Application.ScreenUpdating = False
    Unload Me
    'Vérifier et ouvrir Outlook si pas ouvert
    On Error Resume Next
    Set Messagerie = GetObject(, "Outlook.Application")
    On Error GoTo 0
    If Messagerie Is Nothing Then
        Shell "Outlook.exe" ', vbHide
    End If
    'Fin de la vérification
    Compte_Utilisateur = "p.gonin@zurbuchensa.ch"
    Extension = Cells(ActiveCell.Row, Range("TS_Suivi" & "[Ext]").Column).Value
    If Extension = "fca01" Then
        Recherche = Cells(ActiveCell.Row, Range("TS_Suivi" & "[Cmde]").Column).Value & "." & Extension
    Else
        Position_du_Point = InStr(Extension, ".")
        If Position_du_Point = 0 Then
            Recherche = Cells(ActiveCell.Row, Range("TS_Suivi" & "[Cmde]").Column).Value & " " & Cells(ActiveCell.Row, Range("TS_Suivi" & "[Fournisseur]").Column).Value
        Else
            Recherche = Cells(ActiveCell.Row, Range("TS_Suivi" & "[Cmde]").Column).Value & "." & Right(Extension, Len(Extension) - Position_du_Point)
        End If
    End If
    Set Messagerie = CreateObject("Outlook.Application")
    Set objNS = Messagerie.GetNamespace("MAPI")
    On Error Resume Next    'permet de passer à la ligne suivante pour traiter l'erreur si le calendrier n'est pas trouvé
    Set objRecip = objNS.CreateRecipient(Compte_Utilisateur) '
    Set objFolder = objNS.GetSharedDefaultFolder(objRecip, 6)
                                                '(objRecip, 6) Mail
                                                '(objRecip, 9) Calendrier
                                                '(objRecip, 10) Contact
                                                '(objRecip, 11) Journal
                                                '(objRecip, 12) Notes
                                                '(objRecip, 13) Tâches
    objFolder.Display
    Messagerie.ActiveWindow.WindowState = olMaximized
    Messagerie.ActiveWindow.Activate
    Messagerie.ActiveExplorer.Search Recherche, 4
                                                '0 Dossier actuel
                                                '1 Toutes les boîtes aux lettres
                                                '2 Tous les éléments
                                                '3 Sous dossiers
                                                '4 Boîte aux lettres actuelle
                                                'https://learn.microsoft.com/en-us/office/vba/api/outlook.olsearchscope
    Set Messagerie = Nothing
Application.ScreenUpdating = True
End Sub

[goninph]

Bonjour,

Impossible de trier les résultats de la recherche avec le mail le plus récent en haut de l'affichage

Une idée ?

Meilleures salutations

[goninph]

Toujours pas de solution ?