Discussion :

[Naoned005]

Bonjour a tous

J'ai creer un code VBA qui va me chercher mes piece jointes dans UNE de mes regles et qui me l'enregistre sous le disque dur!

Voici le code (assez cour)

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
  Public Sub TransfertPJ()
    On Error GoTo errorhandler
    '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\"
 
    ' 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.
 
    NomDeFichierSurDisque = Range("C22") & "_" & Range("C20") & "_" & Range("B9")
    att.SaveAsFile Repertoire & NomDeFichierSurDisque
 
    End If
    Next
    Next
 
    Exit Sub
errorhandler:
    MsgBox Err.Description, , Err.Source
    End Sub

Mais le fichier excel ne prend pas le titre que je lui donne (C22,20,B9). Tel quel le fichier s'enregistre sous le nom "___". Je pense que c'est parce que la macro n'ouvre pas le fichier elle l'enregistre directement sous le disque dur.

Que puis je rajouter pour que la macro ouvre le fichier et se referme en prennant en compte les informations C22 C20 et B9 pour nommer le fichier dans le disque dur?

Thanks

Je me demande si c'est une bonne idée de apres 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
    Dim objoutlook As Outlook.Application
    Dim olns As Outlook.Namespace
    Dim mItem As Outlook.MailItem
    Dim att As Outlook.Attachment
    Dim fld As Outlook.MAPIFolder
    Dim Compteur As Integer
    Dim message, Repertoire, NomDeFichierSurDisque, NomDeFichier, Taille, Emetteur As String
    Dim wb As Workbook
    Option Explicit
    Public Sub TransfertPJ()
    On Error GoTo errorhandler
    '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

Donc je disais de simuler l'ouverture de chaqu'un des fichiers enregistré. Comme ça on réenregistre chacun des fichiers sous le titre que l'on veut non?

donc je pensais a ça dans la suite du code mais ça ne semble pas fonctionner

Code :

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

1
2
3
4
5
6
7
8
9
10
11
 
 
'On ouvre les pieces jointe qui sont maintenant des fichiers
Workbooks.Open Filename:=NomDeFichierSurDisque
'Et on les enregistre avec un autre titre tiré des donné du fichier
               With ActiveWorkbooks
 
               NomFichier = .Range("C22") & "_" & .Range("C20") & "_" & .Range("B8")
        End With
        .SaveAs Filename:= NomFichier & ".xls", FileFormat:=xlNormal
        .Close

[patricktoulon]

bonjour

tu n'a pas besoins de tout ca pour ca

tu peut regarder par ICI!!!!

sinon si tu tiens a faire comme ca (ouvrir et reenregistrersous un autre nom )
n'oublie pas d'utiliser une instance d'excel a chaque fois pour les fichiers excel
sinon tu risque de fermer c'elle de la macro
au plaisir

[Naoned005]

Merci patrick

donc j’intègre ton code a ma macro. Le but étant que les fichiers que je viens de prendre de mes pieces jointes de mes mail s'enregistre sous un nom tiré du fichier excel

Voila ou j'ai mi ton code (j'ai rajouté la premiere et la derniere ligne de façon a ce que tu vois où j'ai integré ton 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
att.SaveAsFile Repertoire & NomDeFichierSurDisque
 
 AncienNom = "Z:\Risques et documentation OPCVM\Rapprochement Front Back\Confirmation Trades\Essai\NomDeFichierSurDisque.xls"
    NouveauNom = "titi"
 
 '(je met titi pour l'instant mais l'objectif c'est de mette qq chose comme ça Range("C22") & "_" & .Range("C20") & "_" & .Range("B8") par la suite :))
 
    'Vérifie si le fichier à renommer existe.
    If Dir(AncienNom) = "" Then Exit Sub
    'Renomme le fichier
    Name AncienNom As NouveauNom
 
    End If
 
Next

Mais maintenant dans mon classeur excel je n'est plus q'un fichier et il ne se nomme meme pas titi!!!

Maintenant que j'ai mes fichiers excels (tirée de mes pieces jointe de mail confère plus haut dans la macro) sur le disque. Je pensais a quelque chose du genre

Code :

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

1
2
3
4
5
For each Woorbook in Repertoire '(Le répertoire est nommé plus haut)
 
OpenWorkbook
 
Saveas FileName = .Range("C22") & "_" & .Range("C20") & "_" & .Range("B8")

Mais Woorbook est une variable indéfinie, OpenWorkbook existe? et la derniere ligne il ne la comprend pas!!!!

[patricktoulon]

bonjour

essai pluto un truc du genre
la seule chose que tu a a faire c'est changer le chemin!!!!

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
Sub change_le_nom_des_xls()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
 
 
  chemin = ThisWorkbook.Path & "\"                        ' chemin a adapter
   'on va lister tout les fichiers de type excel en filtrant l'extention
   filtre = "*.xls" ' ou le filtre que tu veux ... par exemple "*.txt" ou même "toto*.*"
 
   fichiers = Dir(chemin & filtre, vbNormal Or vbHidden) 'on prend meme ce qui sont caché
   'c'est parti
   Do While fichiers <> "" '
 
    Workbook.Open (chemin & fichiers)
 
  'on sauve le classeur sous le nom
    ActiveWorkbook.SaveAs Filename:=chemin & Range("C22") & "_" & Range("C20") & "_" & Range("B8") & ".xls", _
        FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
 
   'on va supprimer le fichier portant l'ancien nom
   Set objFSO = CreateObject("Scripting.FileSystemObject")
objFSO.DeleteFile (chemin & fichiers)
 
     fichiers = Dir
   Loop
 
End Sub

je n'ai pas tester mais si je ne me suis pas tromper au niveau de la syntaxe ca devrait fonctionner

au plaisir

[Naoned005]

Merci Patrik ce code m'a l'air a premier vu nickel

donc j'integre ce 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
Sub change_le_nom_des_xls()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
 
 
 
chemin = ThisWorkbook.Path & "Z:\Risques et documentation OPCVM\Rapprochement Front Back\Confirmation Trades\Essai\"                        ' chemin a adapter
   'on va lister tout les fichiers de type excel en filtrant l'extention
   filtre = "*.xls" ' ou le filtre que tu veux ... par exemple "*.txt" ou même "toto*.*"
 
   fichiers = Dir(chemin & filtre, vbNormal Or vbHidden) 'on prend meme ce qui sont caché
   'c'est parti
   Do While fichiers <> "" '
 
    Workbook.Open (chemin & fichiers)
 
  'on sauve le classeur sous le nom
    ActiveWorkbook.SaveAs Filename:=chemin & Range("C22") & "_" & Range("C20") & "_" & Range("B8") & ".xls", _
        FileFormat:=xlExcel8, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
 
   'on va supprimer le fichier portant l'ancien nom
   Set objFSO = CreateObject("Scripting.FileSystemObject")
objFSO.DeleteFile (chemin & fichiers)
 
     fichiers = Dir
   Loop
 
End Sub

Apres celui ci qui me permettait de mettre dans un fichier mes piece jointes d'une de mes regle sur ma boite de reception

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
Dim objoutlook As Outlook.Application
    Dim olns As Outlook.Namespace
    Dim mItem As Outlook.MailItem
    Dim att As Outlook.Attachment
    Dim fld As Outlook.MAPIFolder
    Dim Compteur As Integer
    Dim message, Repertoire, NomDeFichierSurDisque, NomDeFichier, Taille, Emetteur As String
     Dim AncienNom As String, NouveauNom As String
 
 
 
 
    Option Explicit
 
    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 le probleme dans ton code c'est qu'il me dis que
-chemin
-filtre
-fichiers
-Workbook sont des variable non définies??

Pourtant je n'ai pas la case definition des variable obligatoire cochée? Bref je les rentre comme As Variant

mais une fois que cela est fait vba me dis que
-xlExcel8 est une variable non définie aussi??


Merci pour ta réponse je vois le bout du tunnel

[patricktoulon]

rebonjour

comme a mon abitude j'oublie de declarer les variables
ou alors juste pour essayer enleve "option explicit" en haut de module

j'attend le retour?


PS:sur quelle version de excel tu travaille? parce que moi je travaille sur 2007
et si il ne recoonais pas "excel 8" c'est peut etre prarceque tu travaille sur 2003
il va ta falloir refaire la ligne de "saves as"

au plaisir