récupération des pieces jointes

**laurent27530** · 17/11/2023, 09h47

Bonjour

je cherche récupérer les pieces jointes csv dont l'intitule du mail est "PROFIL EXTERNE"

Mon code ne fonctionne pas j'arrive pas a identifier ou est le souci (sur la ligne en gras)
Message d'erreur :
erreur d'execution '-486522875 5e3004005)'
Impossible d'executer cette action sur ce type de pièce jointe

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
Sub IMPORT_PROFIL_EXTERNE()

Dim OutlookOpened As Boolean
Dim outApp As Outlook.Application
Dim outNs As Outlook.Namespace
Dim outFolder As Outlook.MAPIFolder
Dim outAttachment As Outlook.Attachment
Dim outItem As Object
Dim saveFolder As String
Dim outMailItem As Outlook.MailItem
Dim inputDate As String, subjectFilter As String

Application.EnableEvents = False
Application.DisplayAlerts = False


saveFolder = Sheets("MENU").Range("J6")  ' THIS IS WHERE YOU WANT TO SAVE THE ATTACHMENT TO
doszip = Sheets("MENU").Range("J6")
dosfile = Sheets("MENU").Range("J3")

subjectFilter = ("PROFIL EXTERNE") ' THIS IS WHERE YOU PLACE THE EMAIL SUBJECT FOR THE CODE TO FIND

OutlookOpened = False
On Error Resume Next
Set outApp = GetObject(, "Outlook.Application")
If Err.Number <> 0 Then
    Set outApp = New Outlook.Application
    OutlookOpened = True
End If
On Error GoTo 0

If outApp Is Nothing Then
    MsgBox "Cannot start Outlook.", vbExclamation
    Exit Sub
End If

Set outNs = outApp.GetNamespace("MAPI")
Set outFolder = outNs.GetDefaultFolder(olFolderInbox)

If Not outFolder Is Nothing Then
    For Each outItem In outFolder.Items
        If outItem.Class = Outlook.OlObjectClass.olMail Then
            Set outMailItem = outItem
           For Each outAttachment In outMailItem.Attachments
                    If Right(outAttachment.Filename, 4) <> ".csv" Then GoTo line1:
                    outAttachment.SaveAsFile dosfile & outAttachment.Filename
                    datej = Format(FileDateTime(dosfile  & outAttachment.Filename), "yyyy-mm-dd_HH-MM")
                    FileCopy dosfile & outAttachment.Filename, dosfile & datej & "_" & outAttachment.Filename
                    Kill dosfile & outAttachment.Filename
line1:
                    Next
                    Set outAttachment = Nothing
          End If
    Next
End If


If OutlookOpened Then outApp.Quit

Set outApp = Nothing

Application.EnableEvents = True
Application.DisplayAlerts = True

End Sub

**Tête de chat** · 17/11/2023, 12h18

Bonjour,

il y a peut être dans le mail des images ou des choses qui sont considérées comme des attachements qui ne sont pas des fichiers.
Regarde ce qu'il y a dans type qui devrait te permettre de discriminer

Code :

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

1
2
3
4
For Each outAttachment In outMailItem.Attachments
                   debug.print outAttachment.type
                   debug.print outAttachment.displayname
Next

En passant, le goto, c'est le mal absolu. Écris plutôt :

Code :

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

1
2
3
4
5
6
7
8
For Each outAttachment In outMailItem.Attachments
            If Right(outAttachment.Filename, 4) = ".csv" Then 
                    outAttachment.SaveAsFile dosfile & outAttachment.Filename
                    datej = Format(FileDateTime(dosfile  & outAttachment.Filename), "yyyy-mm-dd_HH-MM")
                    FileCopy dosfile & outAttachment.Filename, dosfile & datej & "_" & outAttachment.Filename
                    Kill dosfile & outAttachment.Filename
             End If ' .csv
Next outAttachment