Discussion :

[jean_baptiste_clem]

Bonjour à tous,

Je cherche à archiver sous forme d'un classeur CSV l'ensemble des mails de ma boite qui contiennent au moins une fois l'un des mots listés dans un classeur.

Le but étant de pouvoir consulter en un clin d'oeil les mails de plusieurs personnes lorsque je liste leur nom dans la première colonne d'un classeur.

depuis une heure, je bute sur thisWorkbookPath = Application.ActiveWorkbook.Path qui me renvoie une erreur 438 : propriété ou méthode non gérée par cet objet

L''emploi de thisWorkbookPath = Application.ActiveWorkbook.Path avait pour but d'éviter une erreur rencontrée avec thisWorkbookPath = ThisWorkbook.Path

Au déboguage l'instruction thisWorkbookPath = ThisWorkbook.Path renvoyait une "erreur d'exécution 1004 : la méthode thisworkbook de l'objet _global a échoué"

Bref, là je suis à ma limite

Voici le script fautif :

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
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
Sub MainProcedure()
    Dim thisWorkbookPath As String
    thisWorkbookPath = Application.ActiveWorkbook.Path
    Call ExportOutlookEmailsToCSV(thisWorkbookPath)
End Sub
Sub ExportOutlookEmailsToCSV(thisWorkbookPath As String)
    Dim olApp As Outlook.Application
    Dim olNs As Outlook.NameSpace
    Dim olFolder As Outlook.Folder
    Dim olMail As Outlook.mailItem
    Dim xlApp As Excel.Application
    Dim xlQueryWb As Excel.Workbook
    Dim xlQueryWs As Excel.Worksheet
    Dim cell As Excel.Range
    Dim searchWord As String
    Dim csvFilePath As String
    Dim csvFile As Integer
    Dim outputLine As String
 
    ' Initialisation de l'application Outlook
    On Error Resume Next
    Set olApp = GetObject(, "Outlook.Application")
    If olApp Is Nothing Then
        Set olApp = New Outlook.Application
    End If
    On Error GoTo 0
 
    ' Initialisation du Namespace et du dossier Inbox
    Set olNs = olApp.GetNamespace("MAPI")
    Set olFolder = olNs.GetDefaultFolder(olFolderInbox) ' Inbox
 
    ' Initialisation de l'application Excel et ouverture du fichier "requête Outlook"
    Set xlApp = New Excel.Application
    xlApp.Visible = False
 
    ' Vérification de l'existence du fichier "requête Outlook.xlsx"
    If Dir(thisWorkbookPath & "C:\VBA\requête Outlook.xlsx") = "" Then
        MsgBox "Le fichier 'requête Outlook.xlsx' n'a pas été trouvé.", vbExclamation
        Exit Sub
    End If
 
    ' Ouverture du fichier "requête Outlook"
    Set xlQueryWb = xlApp.Workbooks.Open(thisWorkbookPath & "C:\VBA\requête Outlook.xlsx")
    Set xlQueryWs = xlQueryWb.Sheets(1)
 
    ' Chemin du fichier CSV de sortie
    csvFilePath = thisWorkbookPath & "C:\VBA\résultats Outlook.csv"
    csvFile = FreeFile
 
    ' Création du fichier CSV et écriture des en-têtes
    Open csvFilePath For Output As #csvFile
    Print #csvFile, "mot,titre mail,corps mail,date"
 
    ' Boucle sur chaque mot de la première colonne du fichier "requête Outlook"
    Dim lastRow As Long
    lastRow = xlQueryWs.Cells(xlQueryWs.Rows.Count, 1).End(xlUp).Row
 
    For Each cell In xlQueryWs.Range("A1:A" & lastRow)
        If Not IsEmpty(cell.Value) Then
            searchWord = cell.Value
 
            ' Recherche des mails contenant le mot
            For Each olMail In olFolder.Items
                If TypeName(olMail) = "MailItem" Then
                    If InStr(1, olMail.Subject, searchWord, vbTextCompare) > 0 Or _
                       InStr(1, olMail.Body, searchWord, vbTextCompare) > 0 Then
 
                        ' Écriture des résultats dans le fichier CSV
                        outputLine = """" & searchWord & """,""" & _
                                     Replace(olMail.Subject, """", """""") & """,""" & _
                                     Replace(Replace(olMail.Body, vbCrLf, " "), """", """""") & """,""" & _
                                     olMail.ReceivedTime & """"
                        Print #csvFile, outputLine
                    End If
                End If
            Next olMail
        End If
    Next cell
 
    ' Fermeture du fichier CSV et du fichier Excel "requête Outlook"
    Close #csvFile
    xlQueryWb.Close False
    xlApp.Quit
 
    ' Nettoyage
    Set olMail = Nothing
    Set olFolder = Nothing
    Set olNs = Nothing
    Set olApp = Nothing
    Set xlQueryWs = Nothing
    Set xlQueryWb = Nothing
    Set xlApp = Nothing
 
    MsgBox "Exportation terminée.", vbInformation
End Sub

[Jean-Philippe André]

Salut,

tu as mis cette demande dans VBA Outlook, aussi je pose une question pour débuter :

le code que tu nous partages est-il dans Outlook ou Excel ?

[jean_baptiste_clem]

Bonjour,

Merci pour ce message.
Oui, c'est un script que j'essaie de faire tourner dans un module VBA d'Outlook.

Comme il s'agit de trier des mails, je me suis dit que c'était un passage obligé.

[Jean-Philippe André]

OK,

alors si tu pars de Outlook, Application représente Outlook, et non pas Excel.

Ensuite, dans ton code, tu as des blocs avec

Code :

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

Dir(thisWorkbookPath & "C:\VBA\requête Outlook.xlsx")

ca n'a pas vraiment de sens, car tu tentes de concaténer un chemin avec un autre chemin.

Si tu veux absolument pointer vers le chemin du classeur actif, ca va te prendre d'abord GetObject() de l'application excel, en espérant que tu n'en ai qu'une au moment où tu exécutes la macro.

Mais en relisant ton code, j'ai l'impression que tu as pompé tout ca quelque part et que tu tentes de l'adapter sans comprendre ce que fait le code...

Ce n'est pas une catastrophe, mais ca va te prendre quelque jus de cerveau tout de meme.

Si je comprends ce que tu essaies de faire c'est d'utiliser un fichier requête Outlook.xlsx situé dans le dossier C:\VBA, correct ?

Quel est l'intérêt du paramètre de ta procédure dans ce cas ?

[jean_baptiste_clem]

Oui, j'essaie d'utiliser un fichier requête Outlook.xlsx situé dans le dossier C:\VBA pour faire ma recherche.
L'idée, c'est que dans ce fichier seront stockés la liste des noms qui vont interroger ma messagerie.
Ensuite, le programme est supposé me compiler les mails qui résultent de cette requête dans un autre fichier.

Mais oui, je ne connais pas grand chose en code donc je suis passé par des choses qui existent déjà.

D'où ma présence ici