Renommer une PJ en utilisant l'objet du message

**didie78** · 05/12/2011, 09h41

Bonjour,

J'ai un code VBA sur Outlook 2007 qui me permet d'enregistrer automatiquement lors de l'arrivé d'un nouveau message les pièces jointes vers le disque dur.

J'aimerai ajouter à ce code deux éléments mais ne connaissant pas trop le vba j'ai vraiment besoin d'aide.

J'ai besoin de renommer les pièces jointes : pour celà il faudrait qu'elle porte le nom de l'objet.
Ensuite j'aimerai que les messages soit déplacer dans un sous dossier outlook : ex : Archive

Voici mon script :

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
Sub script(Mail As mailitem)
    Dim myAttachments, myAttachment As Object
    Dim myOrt As String
    Dim myOlApp As New Outlook.Application
    Dim myNamespace As Outlook.NameSpace
    Dim myInbox As Outlook.Folder
    Dim myItems As Outlook.Items
    Dim myItem As Object
    Set myNamespace = myOlApp.GetNamespace("MAPI")
    Set myInbox = myNamespace.GetDefaultFolder(olFolderInbox)
    Set myItems = myInbox.Items
    Dim strName As String
    Dim i As Integer
 
    myOrt = "C:\Documents and Settings\Bureau\macro rename\titi\"
 
 
    For Each myItem In myInbox.Items
 
        strName = myItem.EntryID
 
        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
    End If
 
    Next myItem
 
 
End Sub

Merci d'avance pour votre aide

Sandie

**didie78** · 05/12/2011, 15h37

Bonjour,

Après une multitude de recherche j'ai enfin trouvé le code qui correspond à mon attente :

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
  Sub save_pj(Mail As mailitem)
    Dim myAttachments, myAttachment As Object
    Dim myOrt As String
    Dim myOlApp As New Outlook.Application
    Dim myNamespace As Outlook.NameSpace
    Dim myInbox As Outlook.Folder
    Dim myItems As Outlook.Items
    Dim myItem As Object
    Set myNamespace = myOlApp.GetNamespace("MAPI")
    Set myInbox = myNamespace.GetDefaultFolder(olFolderInbox)
    Set myItems = myInbox.Items
    Set myAttachments = Mail.Attachments
    Dim strName As String
    Dim i As Integer
    Dim Ext
    Dim Nom As String  
 
    Nom = myAttachments.Item(1).DisplayName    
    Ext = Right(Nom, Len(Nom) - InStrRev(Nom, "."))   
 
    myOrt = "C:\Documents and Settings\MAIGNAN-SE\Bureau\macro rename\titi\" & Mail.Subject & "." & Ext
 
    For Each myItem In myInbox.Items
 
        strName = myItem.EntryID
 
        Set myAttachments = Mail.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
                myItem.Body = myItem.Body & _
                    "File: " & myOrt & _
                     vbCrLf               
    Next i
    End If
    Next myItem
End Sub

Ce script lié à une règle permet d'enregistrer automatiquement la pièce jointe du message sur le disque dur en prenant comme nom l'objet du message et l'extension de la pièce jointe.

A bientôt

Sandie

**redalinho** · 26/02/2016, 17h58

bonjour les amis

SVP dans me cas je cherche le code qui renomme la p-j selon l’expéditeur, merci de m'aider afin que je puisse intégrer le code nécessaire dans le programme ci-dessous;

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

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

**Oliv-** · 29/02/2016, 09h42

Bonjour,
Pourquoi poser 3 fois la même question ? Qu'as tu fais des réponses qu'on t'a déjà données ?
http://www.developpez.net/forums/d15...-l-expediteur/
http://www.developpez.net/forums/d15...intes-outllook

**redalinho** · 29/02/2016, 11h25

Envoyé par Oliv-

Bonjour,
Pourquoi poser 3 fois la même question ? Qu'as tu fais des réponses qu'on t'a déjà données ?
http://www.developpez.net/forums/d15...-l-expediteur/
http://www.developpez.net/forums/d15...intes-outllook

bonjour Oliv

j'ai tellement besoin de finalisé cette macro que je poste partout, vraiment désolé :'(
pour t'as réponse j'ai essayer d'adapté le code que tu m'as donné sans succès, je suis encore débutant au VBA

désolé encore pour le désagrément,

**Oliv-** · 29/02/2016, 12h18

il faut changer:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
myAttachments(i).SaveAsFile myOrt & _
myAttachments(i).DisplayName

par

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
myAttachments(i).SaveAsFile myOrt & myItem.SenderName

ce qui fait que 2 pj se nommant toto.pdf et titi.pdf se trouvant dans un Email que tu as envoyé, vont générer le même fichier : "c:\mondossier\redalinho"

Est ce que tu comprends maintenant les problèmes ? il n'y a pas d'extension et pourquoi je te parlais de DOUBLONS ?

**redalinho** · 29/02/2016, 16h33

Envoyé par Oliv-

il faut changer:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
myAttachments(i).SaveAsFile myOrt & _
myAttachments(i).DisplayName

par

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
myAttachments(i).SaveAsFile myOrt & myItem.SenderName

ce qui fait que 2 pj se nommant toto.pdf et titi.pdf se trouvant dans un Email que tu as envoyé, vont générer le même fichier : "c:\mondossier\redalinho"

Est ce que tu comprends maintenant les problèmes ? il n'y a pas d'extension et pourquoi je te parlais de DOUBLONS ?

merci infiniment Oliv, j'ai fait un grand pas j'ai pu exporté les pièces jointes avec le nom des expéditeurs, et j'ai résolu le problème de l’extension en modifient le code comme suit:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

myAttachments(i).SaveAsFile myOrt & myItem.SenderName & myAttachments(i).DisplayName

ll reste juste un petit souci

les Emails que je reçois sont envoyés avec un alias (Exemple: "ADEL KHOUNI" de la part de "EO AEROPRT NATIONAL" comme montré dans l'image

Nom : Eos.JPG
Affichages : 453
Taille : 28,4 Ko

Nom : Eos.JPG
Affichages : 453
Taille : 28,4 Ko

le nom que je veux récupérer c'est "EO AEROPRT NATIONAL" mais avec m'as macro je me trouve avec des fichiers renommés avec les noms des expéditeur "ADEL KHOUNI" et d'autre avec l'alias "EO AEROPRT NATIONAL" bizzare !

**Oliv-** · 29/02/2016, 17h01

Est ce que tu vois une différence dans les Emails lorsque tu as "ADEL KHOUNI" en sauvegarde et les autres ?

**redalinho** · 01/03/2016, 22h16

Envoyé par Oliv-

Est ce que tu vois une différence dans les Emails lorsque tu as "ADEL KHOUNI" en sauvegarde et les autres ?

bonsoir oliv,

non non, pas de différence ! j'ai essayé de remplacé le code "Myitem.senderName" par "Myitem.senderemailadresse" mais cela n'as pas marché,

si tu peux encore m'aider

**Oliv-** · 01/03/2016, 22h55

En mode pas à pas ajoute un espion sur myItem.Sender ou myitem et developpe le résultat pour trouver la proprité qui va bien.

à lire http://www.developpez.net/forums/blo.../debogage-vba/

**Oliv-** · 02/03/2016, 09h35

SAlut,

Essaye avec

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

myAttachments(i).SaveAsFile myOrt & myItem.Sender.Name

**redalinho** · 02/03/2016, 19h47

Envoyé par Oliv-

SAlut,

Essaye avec

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

myAttachments(i).SaveAsFile myOrt & myItem.Sender.Name

Salut

merci encore Oliv, malheureusement ça n'a pas marché :'( je vais jeter un coup d’œil sur la methode pas a pas.

**redalinho** · 02/03/2016, 21h46

Envoyé par redalinho

Salut

merci encore Oliv, malheureusement ça n'a pas marché :'( je vais jeter un coup d’œil sur la methode pas a pas.

alleluiaaaaaaaaaaaaaaaaaaaaa j'ai trouvé le bon code

je partage avec toi le bon code Oliv

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

myItem.SentOnBehalfOfName

merci beaucoup oliv pour ton précieuse aide

Renommer une PJ en utilisant l'objet du message [OL-2007]

VBA Outlook

Discussions similaires

Partager

Partager