[OL-2007] Changer le nom de la pièce jointe à enregistrer [Résolu]

[Secco]

Bonjour

J'ai repris le code ci-dessous issu de la FAQ (d'ailleurs merci à l'auteur !!). Il marche très bien (même si j'ai oté la partie PJ Embedded) , mais j'aurais voulu savoir comment changer le nom de la pièce jointe. En fait, elle s'appelle "Compte" et je la reçois tous les jours et je l'enregistre au même endroit. Donc je voudrais par exemple l'appeler "20101118_Compte".

Merci à toutes celles et ceux qui pourront m'aider.

Secco

Code :

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
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
Sub extrait_PJ_vers_rep(strID As Outlook.MailItem)
 
' ***olivier CATTEAU***
 
' 23 avril 2007
 
    Dim olNS As Outlook.namespace
    Dim MyMail As Outlook.MailItem
 
    Dim expediteur
    Set olNS = Application.GetNamespace("MAPI")
    Set MyMail = olNS.GetItemFromID(strID.EntryID)
 
    'MsgBox "nouveau message"
 
    If MyMail.Attachments.Count > 0 Then
 
        expediteur = MyMail.SenderEmailAddress
 
        'on crée le répertoire où mettre les fichiers joints ##########################################################
 
        'c:\temp\pj\ doit déjà exister !!!
 
        Repertoire = "c:\temp\pj\" & expediteur & "\"
 
        If Repertoire <> "" Then
 
            If "" = Dir(Repertoire, vbDirectory) Then
 
                MkDir Repertoire
 
            End If
 
        End If
 
        'on traite les pj
 
        Dim PJ, typeatt
 
        For Each PJ In MyMail.Attachments
            'vérification si c'est une PJ Embedded
 
            typeatt = Isembedded(strID, PJ.Index)
 
            If typeatt = "" Then
 
                If "" <> Dir(Repertoire & PJ.FileName, vbNormal) Then
 
                    MsgBox Repertoire & PJ.FileName & " existe !!"
 
                    'si existe copie vers le répertoire old
 
                    If "" = Dir(Repertoire & "old", vbDirectory) Then
 
                        MkDir Repertoire & "old"
 
                    End If
 
                    FileCopy Repertoire & PJ.FileName, Repertoire & "old\" & PJ.FileName
 
                End If
 
                PJ.SaveAsFile Repertoire & PJ.FileName
 
            End If
 
        Next PJ
 
        'drapeau vert
 
        MyMail.FlagIcon = olGreenFlagIcon
 
        'Marque lu
 
        MyMail.UnRead = False
 
        MyMail.Save
 
        'on déplace le mail vers un sous dossier outlook
 
        Dim myDestFolder As Outlook.MAPIFolder
 
        Set myDestFolder = MyMail.Parent.Folders("test")
        MyMail.Move myDestFolder
 
    End If
 
    Set MyMail = Nothing
    Set olNS = Nothing
 
Fin:
 
End Sub

[Heureux-oli]

Salut,


Essaie ce morceau de code dans celui que tu as déjà :

Code :

1
2
3
4
5
 
For Each PJ In MyMail.Attachments
            pj.SaveAsFile "C:\Temp\" & Format(Date(),"yyyymmdd") & "_compte.oli"
 
        Next PJ

[Secco]

Merci beaucoup !

J'avais essayé des choses beaucoup plus compliqué en essayant de changer le FileName de la pièce jointe sans succès...

Donc code final : (juste comme mon fichier était compte.txt j'ai mis .txt au lieu de .oli)

Code :

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
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
Sub extrait_PJ_vers_rep(strID As Outlook.MailItem)
 
' ***olivier CATTEAU***
 
' 23 avril 2007
 
    Dim olNS As Outlook.namespace
    Dim MyMail As Outlook.MailItem
 
    Dim expediteur
    Set olNS = Application.GetNamespace("MAPI")
    Set MyMail = olNS.GetItemFromID(strID.EntryID)
 
    'MsgBox "nouveau message"
 
    If MyMail.Attachments.Count > 0 Then
 
        expediteur = MyMail.SenderEmailAddress
 
        'on crée le répertoire où mettre les fichiers joints ##########################################################
 
        'c:\temp\pj\ doit déjà exister !!!
 
        Repertoire = "c:\temp\pj\" & expediteur & "\"
 
        If Repertoire <> "" Then
 
            If "" = Dir(Repertoire, vbDirectory) Then
 
                MkDir Repertoire
 
            End If
 
        End If
 
        'on traite les pj
 
        Dim PJ, typeatt
 
        For Each PJ In MyMail.Attachments
            PJ.SaveAsFile "C:\Temp\" & Format(Date(),"yyyymmdd") & "_compte.txt"
        Next PJ
 
        'drapeau vert
 
        MyMail.FlagIcon = olGreenFlagIcon
 
        'Marque lu
 
        MyMail.UnRead = False
 
        MyMail.Save
 
        'on déplace le mail vers un sous dossier outlook
 
        Dim myDestFolder As Outlook.MAPIFolder
 
        Set myDestFolder = MyMail.Parent.Folders("test")
        MyMail.Move myDestFolder
 
    End If
 
    Set MyMail = Nothing
    Set olNS = Nothing
 
Fin:
 
End Sub

[Heureux-oli]

Salut,

Ne connaissant pas l'extension de ton fichier, j'ai simplement mis une extension bidon.