Récup PJ Outlook mais ne pas retraiter celles déjà faites...

[titiborregan5]

Bonjour à tous,

je suis face à un problème que je ne parviens pas à résoudre...
Je vous explique rapidement ma situation:

1. J'ai un code qui va me récupérer toutes les pièces jointes des mails d'un sous-dossier nommé Retour
2. 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
3. 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 :

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 :

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

 

[titiborregan5]

Re : Récup PJ Outlook mais ne pas retraiter celles déjà faites...

J'ai trouvé...
en fait quand je rajoute le listing des fichiers ça met que la variable Dossier est vide du coup je peux pas écrire...
J'ai donc défini cette variable en dur au début & ça a l'air de marcher...
Comme ça avec un recherchev ça va me dire s'il ne trouve pas le fichier dans 1ère liste et donc il traitera que les dossiers pour lesquels recherchev = #N/A...

A+
Tibo