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
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 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
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" ????
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
Et ça bug sur cette ligne de code
Et là je bloque
Code : Sélectionner tout - Visualiser dans une fenêtre à part att.SaveAsFile Repertoire & NomDeFichierSurDisque
Qq a déjà eu ce probleme??
mErci
Partager