Bonjour,
J'ai récupéré un code sur ce site pour extraire automatiquement les pièces jointes Outlook via VBA. ça marche bien, mais j'ai un problème parce qu'il parcourt à chaque fois tous les dossiers de ma boite mail, alors que je ne voudraise récupérer que le spieces jointes de mon dossier "Test".
1) Pourriez vous me dire SVP comment modifier leprogramme ci-dessous pour spécifier un seul dossier d'extraction.
2) Est ce qu'on pourrait aussi spécifier les adresses qu'il doit regarder. Autrement dit, forcer le programme à extraire seulement le spieces jointes des adresses qu'on lui donnera.
D'avance merci.
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 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("Nom_Du_Dossier").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 = x + 1 pceJointe.SaveAsFile "C:\PJ\" & x & "_" & pceJointe Set pceJointe = Nothing Next y End If Next OLmail End If SearchFolders SousDossier Next SousDossier End Sub
Partager