Importer et renommer les pièces jointes outllook
Bonsoir
Besoin d'aide, je cherche un programme en VBA qui récupère les pièces jointes excel dans des email Outlook (boite de réception ou dossier archivé) ensuite les renommé selon les expéditeur et l'enregistre automatiquement dans un dossier spécifique.
j'ai trouvé le programme ci-dessous qui enregistre les Pièce-joints dans un dossier, je dois maintenant intégrer un code afin qu'il renomme les pièces joints selon l’expéditeur ;
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:\CdeDELL\Facture\")
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
'Ajoute une remarque dans le corps du message
myItem.Body = myItem.Body & vbCrLf & _
"pièce jointe enlevée:" & vbCrLf
'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
'Enlève les pièces jointes du message
While myAttachments.Count > 0
myAttachments(1).Delete
Wend
'Sauvegarde le message sans ses pièces jointes
myItem.Save
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
merci d'avance
aucun avatar redalinho
Nouveau venu
Nouveau venu
Messages: 1
Inscription: 03 Fév 2016, 19:30
Version Excel: 2007
Répondre avec citation
Oliv'
Partager