Discussion :

[h_faty]

Bonjour à tous,

J'ai un peu le même besoin que "ivanG" dans cette discussion sauf que dans mon cas je souhaite récupérer les pièces jointes à partir des archives outlook, je vous explique !
J'ai un dossier dans lequel j'ai stocké une liste de mail (fichiers .msg) et dans chacun il y'a un fichier excel.
Donc ce que je veux faire c'est récupérer toutes les pièces jointes et les enregistrer par la suite dans un autre dossier.

Je suis vraiment nulle en VBA vue que c'est la première fois que travaille avec, donc j'ai essayé plusieurs code que j'ai trouvé sur internet mais aucun d'entre n'a fonctionné :/.

Pouvez-vous m'aider SVP ?

[parmi]

Bonjour,

Quand tu parles de dossier, tu veux dire sur le disque dur (ou réseau) ?
Si oui, qu'est-ce que tu fais s'il y a plusieurs fichiers avec le même nom ?

[h_faty]

Re bonjour,


Quand tu parles de dossier, tu veux dire sur le disque dur (ou réseau) ?
=> c'est sur le réseau
Si oui, qu'est-ce que tu fais s'il y a plusieurs fichiers avec le même nom ?
=> le nommage ressemble à ça : rapport01062014.msg (la date change )

[parmi]

En fait, je parlais des fichiers joints aux messages.
S'ils peuvent avoir le même nom d'un message à l'autre, ça causera une erreur.
Il faudrait alors lui ajouter un chiffre ou quelque chose comme ça...

[h_faty]

Non, au fait c'est la même chose dans les fichiers ça change en fonction de la date

[parmi]

Je fais une vérification que ce sont bien des messages .MSG
Ensuite, je vérifie l'extension pour ne copier que les fichiers Excel.
S'il y a d'autres types de fichiers, change la condition.

Il faut savoir que s'il y a des images dans le message (signature ou autre...), elles seront copiées aussi...

Il te reste à inscrire les chemins des fichiers MSG et de destination.
Nul besoin de référence à Outlook.

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 SaveMSG()
    Dim objOL As Object
    Dim objItem As Object
    Dim Attach As Object, NomFichier As String
    Dim CheminMSG As String, CheminDest As String
    Dim Fichier As Variant
    
    CheminMSG = "Chemin des fichiers MSG"
    If Right(CheminMSG, 1) <> "\" Then CheminMSG = CheminMSG & "\"
    CheminDest = "Chemin de destination"
    If Right(CheminDest, 1) <> "\" Then CheminDest = CheminDest & "\"
    
    Set objOL = CreateObject("Outlook.Application")
    
    Fichier = Dir(CheminMSG, vbArchive)
    Do While LCase(Right(Fichier, 3)) = "msg" 'vérifie que ce sont bien des .MSG
        Set objItem = objOL.CreateItemFromTemplate(CheminMSG & Fichier)
        For Each Attach In objItem.Attachments 'lecture de tous les fichiers joints
            NomFichier = Attach.Filename
            'Copie les fichiers Excel seulement
            If InStr(1, NomFichier, ".xls") > 0 Then Attach.SaveAsFile CheminDest & NomFichier
        Next
        
        Fichier = Dir
    Loop
    
    Set objItem = Nothing
    Set objOL = Nothing
End Sub

[h_faty]

Super ! ça marché

Merci beaucoup

[h_faty]

Bonjour à tous,

Je voudrais savoir s'il y'a un moyen d'ajouter un champ dans la première feuille de chaque fichier avec le nom du fichier.

J'ai essayé sur un seul fichier avec la commande suivante :

Sheets(1).Range("N1").Value = ActiveWorkbook.Name

ça a marché ! mais le soucis que j'arrive pas à le faire avec tout une liste de fichiers

et au même temps je veux récupérer juste la première feuille de mes classeurs, donc j'ai ajouté au programme de "parmi" ces deux lignes de code:
Sheets(2).Delete
Sheets(3).Delete
il m'affiche pas d'erreur mais ces feuilles ne sont pas supprimées !


Pourriez vous m'orienter svp ?

Merci d'avance !

[parmi]

Je te conseillerais d'ouvrir un nouveau sujet.
Comme celui-ci est marqué "résolu", plusieurs ne s'y arrêteront pas...

[h_faty]

D'accord, merci