Outlook VBA: enregistrer pièces-jointes de plusieurs mails Le sujet est résolu

Y compris Power BI, Power Query et toute autre question en lien avec Excel
Répondre
D
Donou12
Nouveau venu
Nouveau venu
Messages : 6
Inscrit le : 20 octobre 2017
Version d'Excel : 2013

Message par Donou12 » 2 janvier 2018, 12:07

Bonjour, tout d'abord mes meilleurs voeux pour cette nouvelle année!
Celle-ci commence avec un problème à résoudre (youhou). Je suis conscient que le forum s'appelle "Excel-pratique", mais comme mon problème est lié à du VBA je me suis dit que vous pourriez m'aider quand même.

Je souhaite pouvoir enregistrer les pièces jointes de plusieurs mails en même temps dans un dossier donné. (le nom du dossier est libre, disons "nouveau dossier").

J'ai déjà parcouru tous les sujets sur la question sur le net, la seule macro qui entraine une modification quelque part est celle-ci: (je l'ai mise dans un module)
Sub SaveAttachment()

'Declaration
Dim myItems, myItem, myAttachments, myAttachment As Object
Dim myOrt As String
Dim myOlApp As New Outlook.Application
Dim myOlExp As Outlook.Explorer
Dim myOlSel As Outlook.Selection
Dim i As Integer

'Boîte de dialogue simple pour le chemin de sauvegarde
myOrt = InputBox("Destination", "Save Attachments", "C:\PJ\")

On Error Resume Next

'Actions sur les objets sélectionnés
Set myOlExp = myOlApp.ActiveExplorer
Set myOlSel = myOlExp.Selection

'boucle
For Each myItem In myOlSel
Set myAttachments = myItem.Attachments
If myAttachments.Count > 0 Then


'for all attachments do...
For i = 1 To myAttachments.Count

'save them to destination
myAttachments(i).SaveAsFile myOrt & _
myAttachments(i).DisplayName
myItem.Body = myItem.Body & _
"File: " & myOrt & _
myAttachments(i).DisplayName & vbCrLf

Next i


End If

Next

Set myItems = Nothing
Set myItem = Nothing
Set myAttachments = Nothing
Set myAttachment = Nothing
Set myOlApp = Nothing
Set myOlExp = Nothing
Set myOlSel = Nothing

End Sub
Problème:
-il y a bien un msgbox qui apparaît (il faut à ce moment renseigner l'emplacement du dossier dans lequel on veut enregistrer les PJ), mais les pièces-jointes ne s'enregistrent pas dans l'emplacement renseigné. Elles s'enregistrent nulle part en fait.
-Le mail est modifié : l'emplacement renseigné dans le msgbox ainsi que le nom de la PJ s'inscrivent alors sur le mail! = JE VEUX PAS
-Cette macro s'applique que sur un seul mail même si j'en sélectionne plusieurs

Exemple: Ma PJ s'appelle "Test"

je mets dans le Msgbox mon emplacement cible : C:\Users\Toto\Documents
A la fin de la macro, mon mail comportera le texte : File: C:\Users\Toto\DocumentsTest.pdf


Donc:


1) Je souhaite que la macro tienne compte des mails qui sont sélectionnés uniquement.
2) Je souhaite enregistrer les pièces-jointes dans un dossier situé sur le bureau (le msgbox où il faut indiquer l'emplacement peut-être conservé, je pourrai ensuite ajouter par défaut le chemin d'un dossier sur le bureau)
3) Je souhaite garder intacts les mails et les PJ


J'ai pensé à modifier le code pour réaliser des copier/coller, mais sans succès.
Je vous remercie par avance.

Donou
D
Donou12
Nouveau venu
Nouveau venu
Messages : 6
Inscrit le : 20 octobre 2017
Version d'Excel : 2013

Message par Donou12 » 2 janvier 2018, 14:06

Re-bonjour,

J'ai trouvé, voici un code:
 Sub test1()

Dim MonMail As Outlook.MailItem
Dim Olk_selex As Outlook.Selection
Dim OutlookApp As New Outlook.Application
Dim OutlookExp As Outlook.Explorer
Dim MonNSpace As Outlook.NameSpace
Dim MyPath, myort, ext, a As String
Dim i, j As Integer
Dim MesAttachments
 
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookExp = OutlookApp.ActiveExplorer
Set MonNSpace = OutlookApp.GetNamespace("MAPI")
Set Olk_selex = OutlookExp.Selection
 
For i = 1 To Olk_selex.Count
 
        Set MonMail = Olk_selex.Item(i)
        Set MesAttachments = MonMail.Attachments ' recuperation des PJs
 
        If MesAttachments.Count > 0 Then
 
            For j = 1 To MesAttachments.Count
 
                    MesAttachments(j).SaveAsFile "MON CHEMIN" & _
                    MesAttachments(j).DisplayName
 
            Next j
 
        End If
 
Next i

End Sub
Répondre
  • Sujets similaires
    Réponses
    Vues
    Dernier message