Bonjour à tous,
aujourd'hui j'ai le code suivant qui fonctionne très bien:
Option Explicit
'------------------------------------------------------------------------
'Nécessite d'activer la référence Microsoft Outlook xx.xx Object Library
'------------------------------------------------------------------------
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
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
Dim S_Commande As Worksheet
Dim Chemin As String
Set S_Commande = ThisWorkbook.Sheets("Commande")
Chemin = S_Commande.Cells(3, 2).Value
For Each SousDossier In Fld.Folders
If SousDossier.DefaultItemType = 0 And SousDossier = "Test" Then
y = 1
For Each OLmail In SousDossier.Items
Set pceJointe = OLmail.Attachments(y)
pceJointe.SaveAsFile Chemin & y & "_" & pceJointe
y = y + 1
Set pceJointe = Nothing
Next OLmail
End If
SearchFolders SousDossier
Next SousDossier
End Sub
Il me permet de prendre toutes les pièces jointes des mails situés dans le dossier Test, et de les télécharger pour les envoyer dans un dossier de mon bureau renseigné dans la variable chemin. J'aimerais modifier ce code ou l'améliorer.
Ce que je souhaiterais faire, c'est ajouter une ligne de code, (à mon avis au dessus de "y = y + 1") qui me permettrait juste après le téléchargement de la pièce jointe, de transférer le mail contenant cette pièce jointe dans un autre dossier Outlook nommé Test2. Lorsque je dis "ajouter une ligne de code", ça peut être plus, mais je pense que c'est pas trop compliqué, bien que je ne sache pas comment m'y prendre. Une idée ?
Bonne journée les amis !
SkillzZ
aujourd'hui j'ai le code suivant qui fonctionne très bien:
Option Explicit
'------------------------------------------------------------------------
'Nécessite d'activer la référence Microsoft Outlook xx.xx Object Library
'------------------------------------------------------------------------
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
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
Dim S_Commande As Worksheet
Dim Chemin As String
Set S_Commande = ThisWorkbook.Sheets("Commande")
Chemin = S_Commande.Cells(3, 2).Value
For Each SousDossier In Fld.Folders
If SousDossier.DefaultItemType = 0 And SousDossier = "Test" Then
y = 1
For Each OLmail In SousDossier.Items
Set pceJointe = OLmail.Attachments(y)
pceJointe.SaveAsFile Chemin & y & "_" & pceJointe
y = y + 1
Set pceJointe = Nothing
Next OLmail
End If
SearchFolders SousDossier
Next SousDossier
End Sub
Il me permet de prendre toutes les pièces jointes des mails situés dans le dossier Test, et de les télécharger pour les envoyer dans un dossier de mon bureau renseigné dans la variable chemin. J'aimerais modifier ce code ou l'améliorer.
Ce que je souhaiterais faire, c'est ajouter une ligne de code, (à mon avis au dessus de "y = y + 1") qui me permettrait juste après le téléchargement de la pièce jointe, de transférer le mail contenant cette pièce jointe dans un autre dossier Outlook nommé Test2. Lorsque je dis "ajouter une ligne de code", ça peut être plus, mais je pense que c'est pas trop compliqué, bien que je ne sache pas comment m'y prendre. Une idée ?
Bonne journée les amis !
SkillzZ