Discussion :

[Naoned005]

Bonjour

J'ai un code VBA qui m'enregistre toute mes pieces jointe d'un sous dossier de ma messagerie sous un dossier de mon disque dur. Il fonctionne tres bien

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
 
    Public Sub TransfertPJ()
 
    'Création de l'objet Outlook
    Set objoutlook = CreateObject("Outlook.application")
    'Récupération de l'espace de nom d'outlook
    Set olns = objoutlook.GetNamespace("MAPI")
    'Récupération du répertoire "boite de réception" par défault
    Set fld = olns.GetDefaultFolder(olFolderInbox)
    ' Initialisation du reperetoire de sauvegarde
    ' ne pas oublier l'anti-slash à la fin du repertoire
    Repertoire = "Z:\Risques et documentation OPCVM\Rapprochement Front Back\Confirmation Trades\Essai\"
    'Inialisation des variables Message, NomDeFichier, NomDeFichierSurDisque, Taille, Emetteur
    message = NomDeFichierSurDisque = NomDeFichier = Taille = Emetteur = ""
 
    ' Sauve les pieces jointes des mails se trouvant dans la boîte de réception.
    ' Pour adresser un dossier dans la boite de réception on pourrait utiliser :
    ' fld.Folders("Nom_Du_Dossier").Items
For Each mItem In fld.Folders("Confirmation Oddo").Items
 
    For Each att In mItem.Attachments
    If att.Type = olByValue Then
 
    ' Nom du fichier modifié pour l'enregistrement. Evite les controles superflus en renommant.
 
    NomDeFichier = att.Filename
    NomDeFichierSurDisque = NomDeFichier
    att.SaveAsFile Repertoire & NomDeFichierSurDisque
 
 
 
 
 
 
    End If
    Next
    Next
 
 
 
 
    Exit Sub
 
    End Sub

Maintenant je corse le probleme j'ai essayé un code qui enregistre non pas sous un classeur identique a chaque fois mais sous un classeur titrant avec la date de la veille chaque jour. Si celui ci n'est pas dejà creer dans le disque dur mon code le crée. Donc j'ai creer une fonction veille, modifié les chemins.. voila mon code

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
46
47
48
49
50
51
52
53
54
55
56
57
58
59
Public Sub TransfertPJ()
 
    'Création de l'objet Outlook
    Set objoutlook = CreateObject("Outlook.application")
    'Récupération de l'espace de nom d'outlook
    Set olns = objoutlook.GetNamespace("MAPI")
    'Récupération du répertoire "boite de réception" par défault
    Set fld = olns.GetDefaultFolder(olFolderInbox)
    ' Initialisation du reperetoire de sauvegarde
    ' ne pas oublier l'anti-slash à la fin du repertoire
    Rep = "Z:\Risques et documentation OPCVM\Rapprochement Front Back\Confirmation Trades"
 
    'Si le répertoir père existe
If Dir(Rep, vbDirectory) <> "" Then
    'Dans maDate on récuppère la date de la veille (si c'est un dimanche ou lundi, on prend vendredi précédent
    'Ici appel à la fonction veille
    MaDate = Veille
 
    'On va chercher si le sous répertoire du mois existe au sein du répertoire père, on le crée s'il n'existe pas
    RepMois = Rep & "\" & Format(MaDate, "mmmm yyyy")
    If Dir(RepMois, vbDirectory) = "" Then MkDir RepMois
    'On va chercher si le sous répertoire du jour existe au sein du sous répertoire du mois, on le crée s'il n'existe pas
    RepJour = RepMois & "\" & Format(MaDate, "yyyymmdd")
    If Dir(RepJour, vbDirectory) = "" Then MkDir RepJour
    'Inialisation des variables Message, NomDeFichier, NomDeFichierSurDisque, Taille, Emetteur
    message = NomDeFichierSurDisque = NomDeFichier = Taille = Emetteur = ""
 
    ' Sauve les pieces jointes des mails se trouvant dans la boîte de réception.
    ' Pour adresser un dossier dans la boite de réception on pourrait utiliser :
    ' fld.Folders("Nom_Du_Dossier").Items
For Each mItem In fld.Folders("Confirmation Oddo").Items
 
    For Each att In mItem.Attachments
    If att.Type = olByValue Then
 
    ' Nom du fichier modifié pour l'enregistrement. Evite les controles superflus en renommant.
 
 
 
 
    NomDeFichier = att.Filename
    NomDeFichierSurDisque = NomDeFichier
    att.SaveAsFile Repertoire & NomDeFichierSurDisque
 
 
 
    End If
    Next
    Next
 
 
End If
    End Sub
  Private Function Veille() As Date
Dim d As Byte
 
d = DatePart("w", Date, vbSunday)                'Si Date est Dimanche ou Lundi, on prend Vendredi comme étant la veille. 'Sinon, on prend j-1
Veille = Date - IIf(d <= 2, d + 1, 1)
End Function

Mais quand je lance celui ci ça me fait "Impossible d'enregistrer la piece jointe, vous ne disposez pas des autorisations nécessaires pour effectuer l'opération" ????

Et ça bug sur cette ligne de code

Code :

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

att.SaveAsFile Repertoire & NomDeFichierSurDisque

Et là je bloque

Qq a déjà eu ce probleme??

mErci

[SfJ5Rpw8]

Et ou renseigne tu la valeur de ta variable Repertoire...?

[carden752]

Bonjour,

Ne serait-ce pas repjour au lieu de repertoire à utiliser?

Code :

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

att.SaveAsFile RepJour & NomDeFichierSurDisque

[Gorzyne]

J'ai le même problème, Autorisations nécessaires ...
si quelqu'un a une solution