Bonjour à tous,
je suis face à un problème que je ne parviens pas à résoudre...
Je vous explique rapidement ma situation:
- J'ai un code qui va me récupérer toutes les pièces jointes des mails d'un sous-dossier nommé Retour
- J'ai un autre code qui va, une fois les PJ enregistrées, détecter les fichiers Excel, les ouvrir et s'ils répondent à certaines conditions recopier certaines valeurs, enregistrer au format voulu et sauvegarder
- On passe ensuite à la PJ suivante
Tout ça marche nickel mais c'est long car j'ai plus de 300 fichiers pour l'instant et je devrais monter jusqu'à 600...
Du coup me suis dit, au lieu de tout reprendre à 0 à chaque fois, je vais faire une liste des PJ "*.xls" en début de code (avant la récup des PJ), puis faire la récup des PJ (qui réécrira avec le même nom les PJ déjà présentes et ajouter les nouvelles) puis faire une nouvelle liste des PJ avec un recherchev entre les 2 pour détecter celles présentes dans la 2ème liste et non dans la 1ère pour ne rajouter que celles-ci...
Problème, le code de récup étant assez complexe, je ne parviens pas à le mixer avec les listes des fichiers...
Du coup, j'obtiens un message d'erreur (cf copie d'écran)...
Sur le code suivant :
Code vba:
Option Explicit
'------------------------------------------------------------------------
'Nécessite d'activer la référence Microsoft Outlook xx.xx Object Library
'------------------------------------------------------------------------
Dim x As Integer
Dim Dossier, Dossier2
'La boite de réception, la boite des éléments supprimés et tous leurs
'sous dossiers sont pris en compte.
Sub ExportePiecesJointes()
Dim Ol As New Outlook.Application
Dim Ns As Outlook.Namespace
Dim Dossier As Outlook.MAPIFolder
Set Ns = Ol.GetNamespace("MAPI")
Set Dossier = Ns.Folders(1)
'MsgBox Dossier
SearchFolders Dossier
x = 0
MsgBox "Fichiers chargés"
End Sub
Private Sub SearchFolders(ByVal fld As Outlook.MAPIFolder)
Dim y As Integer
Dim OLmail 'As Outlook.MailItem
Dim pceJointe As Outlook.Attachment
Dim SousDossier As Outlook.MAPIFolder
For Each SousDossier In fld.Folders
'With fld.Folders
'.Item("Retours").Items
If SousDossier.DefaultItemType = 0 And SousDossier.Name = "Retours" Then
For Each OLmail In SousDossier.Items
If Not OLmail.Attachments.Count = 0 Then
For y = 1 To OLmail.Attachments.Count
'MsgBox SousDossier.Name
Set pceJointe = OLmail.Attachments(y)
x = x + 1
'l'erreur apparaît là alors que ça marche quand je ne fais que ce code!!
pceJointe.SaveAsFile Dossier & x & "_" & pceJointe
Set pceJointe = Nothing
Next y
End If
Next OLmail
End If
SearchFolders SousDossier
Next SousDossier
'MsgBox x & " fichiers enregistrés"
End Sub
Le code pour lister les PJ :
Code vba:
Dim Chem, NF2
Sub t1()
With Sheets("Accueil")
.Range("r2:r65000").ClearContents
Chem = "C:\Documents and Settings\thibault.spreux\Bureau\Compta Ana\Gestion des temps\PJ Mails"
ChDir Chem
.Range("r2").Select
NF2 = Dir("*.xls")
Do While NF2 <> ""
ActiveCell = NF2
ActiveCell.Offset(1, 0).Select
NF2 = Dir
Loop
End With
End Sub
Je ne sais pas du tout comment faire, si qq1 a une idée je suis preneur...
D'avance Merci
