Extraction mails boite mail outlook

Le 17/11/2023 à 12:20

Bonjour ,

J'ai récupéré un code vba sur le forum pour extraire toutes les pieces jointe de mon mail Outlook.

Quand je veux l'exécuter il m'affiche l'erreur suivante

x pceJointe.SaveAsFile "C:\PJ\" & x & "_" & pceJointe= x + 1

avec pour code erreur : impossible d'enregistrer la piece jointe . ce chemin d'acces nexiste pas

Qu'elqu'un peut m'aider svp . je suis ultra debutante et nul en vba.

Option Explicit
'------------------------------------------------------------------------
'Nécessite d'activer la référence Microsoft Outlook xx.xx Object Library
'------------------------------------------------------------------------


Dim x As Integer
'La boite de réception, la boite des éléments supprimés et tous leurs
'sous dossiers sont pris en compte.
Sub ExportePiecesJointes()
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
x = 0
End Sub


Private Sub SearchFolders(ByVal fld As Outlook.MAPIFolder)
Dim y As Integer
Dim OLmail 'As Outlook.MailItem
Dim pceJointe As Outlook.Attachment
Dim SousDossier As Outlook.MAPIFolder

For Each SousDossier In fld.Folders
'.Item("boite de reception").Items
If SousDossier.DefaultItemType = 0 Then
For Each OLmail In SousDossier.Items
If Not OLmail.Attachments.Count = 0 Then
For y = 1 To OLmail.Attachments.Count
Set pceJointe = OLmail.Attachments(y)

x pceJointe.SaveAsFile "C:\PJ\" & x & "_" & pceJointe= x + 1

Set pceJointe = Nothing
Next y
End If
Next OLmail
End If
SearchFolders SousDossier
Next SousDossier
End Sub

Le 17/11/2023 à 13:01

Bonjour et

Essai comme ça :

Option Explicit
'------------------------------------------------------------------------
'Nécessite d'activer la référence Microsoft Outlook xx.xx Object Library
'------------------------------------------------------------------------

Dim x As Integer
'La boite de réception, la boite des éléments supprimés et tous leurs
'sous dossiers sont pris en compte.
Sub ExportePiecesJointes()
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
x = 0
End Sub

Private Sub SearchFolders(ByVal fld As Outlook.MAPIFolder)
Dim y As Integer
Dim EmplacementPJ As String
Dim OLmail 'As Outlook.MailItem
Dim pceJointe As Outlook.Attachment
Dim SousDossier As Outlook.MAPIFolder

For Each SousDossier In fld.Folders
    '.Item("boite de reception").Items
    If SousDossier.DefaultItemType = 0 Then
        For Each OLmail In SousDossier.Items
            If Not OLmail.Attachments.Count = 0 Then
                For y = 1 To OLmail.Attachments.Count
                    Set pceJointe = OLmail.Attachments(y)

                    EmplacementPJ = "C:\PJ\"
                    If Dir(EmplacementPJ, vbDirectory) = vbNullString Then MkDir (EmplacementPJ)
                    pceJointe.SaveAsFile EmplacementPJ & x & "_" & pceJointe
                    x = x + 1

                    Set pceJointe = Nothing
                Next y
            End If
        Next OLmail
    End If
    SearchFolders SousDossier
Next SousDossier
End Sub

J'ai rajouté la variable "EmplacementPJ" qui va définir l'endroit ou va se stocker tes pieces jointes

EmplacementPJ = "C:\PJ\"
If Dir(EmplacementPJ, vbDirectory) = vbNullString Then MkDir (EmplacementPJ)

"If dir" va creer un dossier suivant ce que tu as dans la variable "EmplacementPJ" si il n'existe pas

et j'ai modifié la partie avec l'increment du x (coquille dans ton copier-coller)

x = x + 1

A+

Le 17/11/2023 à 16:55

Bonjour

merci j'arrive pas a executer le code

Il mindique que les macros de ce projet sont désactivés .

Le 23/11/2023 à 08:25

Bonjour,

Je pensais t'avoir répondu, essai d'aller dans le ruban Developpeur -> sécurité des macros

image

Voir l'option activée

image

Je pense qu'il faudra relancer la seession Outlook et quand tu vas vouloir lancer "Sub ExportePiecesJointes()",

il va te proposer d'activer ou non les macros.

A+

PS: tu peux changer cette ligne de code :

pceJointe.SaveAsFile EmplacementPJ & x & "_" & pceJointe

par

pceJointe.SaveAsFile EmplacementPJ & x & "_" & pceJointe.Parent.SenderName & "_" & Format(pceJointe.Parent.ReceivedTime, "dd-mmm-yy") & "_" & pceJointe

Pour ajouter le nom de l'expéditeur de mail et la date d'envoi aux pieces jointes qui seront dans le dossier C:\PJ\

Rechercher des sujets similaires à "extraction mails boite mail outlook"