traiter puis archiver les messages

C@thy

C@thy

XLDnaute Barbatruc
Bonsoir le forum,

je cherche sous Outlook (je précise : je pars bien d'une macro sous Outlook) à copier vers un tableau excel tous les mails d'un répertoire.

Pour chaque message d'un certain répertoire situé sous la boîte de réception, je copie les éléments : expéditeur, date, objet dans un tableau excel puis j'archive le mail que je viens de traiter dans un sous-répertoire traité.

(au début je l'avais fait sous excel, mais il le faut sous outlook)

voici la macro sous excel :

Code: 
Public num_id_arrivé As String
Sub start()
With Application: .ScreenUpdating = False: .DisplayAlerts = False: End With
Mails_contactsOutlook
With Application: .ScreenUpdating = True: .DisplayAlerts = True: End With
End Sub

Private Sub Mails_contactsOutlook()
    Dim myOlApp As New Outlook.Application
    Dim Cible As Outlook.ContactItem
    Dim myInbox As Outlook.MAPIFolder
    Dim myDestFolder As Outlook.MAPIFolder
    Dim Ns As Outlook.Namespace
    Dim OLmail As Outlook.MailItem
    Dim nbmsg As Integer
    
    Dim NbJours As Long, DatePlusCinq As Date
    Dim an As Integer
    Dim myItems As Outlook.Items
    
    Set olApp = CreateObject("Outlook.Application")
    Set Ns = olApp.GetNamespace("MAPI")
    Set myInbox = Ns.GetDefaultFolder(olFolderInbox) 'Boîte de réception
     Dim myInbox As Outlook.MAPIFolder
    'balOutlook = Cells(2, 7).Value
     v = Split(myInbox.FolderPath, "\") ''
     balOutlook = v(UBound(v) - 1) ''Boîte de réception
     Set myInbox = Ns.Folders(balOutlook).Folders("Prise en charge demande") 'Dossiers d'archivage, dossiers locaux, IMAP, BAL BANCILLON C, Dossiers Personnels, ArchivOulookBANCILLON, Dossiers d'archives, Dossiers publics
     NbJours = CLng(Date)
     DatePlusCinq = CDate(NbJours + 5)
     
     For Each OLmail In myInbox.Items
                a = Range("A" & Cells.Rows.Count).End(xlUp)(2, 1).Row
                id_courrier_arr
                Range("A" & a) = num_id_arrivé
                Range("B" & a) = OLmail.CreationTime
                Range("C" & a) = Date
                Range("D" & a) = OLmail.SenderName
                Range("F" & a) = OLmail.Subject
                Range("G" & a) = DatePlusCinq
                Range("R" & a) = DatePlusCinq + 42
                Archivage
     Next OLmail
     For Each OLmail In myInbox.Items
                a = Range("A" & Cells.Rows.Count).End(xlUp)(2, 1).Row
                id_courrier_arr
                Range("A" & a) = num_id_arrivé
                Range("B" & a) = OLmail.CreationTime
                Range("C" & a) = Date
                Range("D" & a) = OLmail.SenderName
                Range("F" & a) = OLmail.Subject
                Range("G" & a) = DatePlusCinq
                Range("R" & a) = DatePlusCinq + 42
                Archivage
     Next OLmail
                
                End Sub
                
  Sub id_courrier_arr()
  Dim an_arr As Integer
  Dim incremen_arr As Variant
'recherche la derniére cellule non vide
    Range("A65536").End(xlUp).Select
'déconposition de l'id arrivé
   an_arr = Left(ActiveCell.Value, 4)
'   Stop
an = Year(Date)
   If an_arr <> an Then
      an_arr = Year(Date)
      incremen_arr = "00"
   Else
      incremen_arr = Right(ActiveCell.Value, Len(ActiveCell.Value) - 5)
   End If
   
   incremen_arr = incremen_arr + 1
   Do Until Len(incremen_arr) = 3
      incremen_arr = "0" & incremen_arr
   Loop
'incrémente la partie droite du num id
   num_id_arrivé = an_arr & "-" & incremen_arr
End Sub
                
Sub Archivage()
Dim olApp As Outlook.Application
    Dim Cible As Outlook.ContactItem
    Dim myInbox As Outlook.MAPIFolder
    Dim myDestFolder As Outlook.MAPIFolder 'dossier de destination pour l'archivage
    Dim Ns As Outlook.Namespace
    Dim OLmail As Outlook.MailItem
    Dim NbJours As Long, DatePlusCinq As Date
    Dim an As Integer
    
    Set olApp = CreateObject("Outlook.Application")
    Set Ns = olApp.GetNamespace("MAPI")
    
    Set myInbox = Ns.GetDefaultFolder(olFolderInbox)
    v = Split(myInbox.FolderPath, "\") ''
    balOutlook = v(UBound(v) - 1)

    Set myInbox = Ns.Folders(balOutlook).Folders("Prise en charge demande")
    Set myDestFolder = myInbox.Folders("suivi demandes")
  
                myInbox.Items(1).UnRead = False 'courriel le plus ancien
                myInbox.Items(1).Move myDestFolder
End Sub
le seul problème c'est que je suis obligée de faire 2 fois le For Each OLmail In myInbox.Items car sinon le dernier mail n'est pas traité:confused::confused::confused:

En fait je crois que je m'y prends mal,
je devrais sans doute constituer un tableau
Code: 
ReDim Preserve emails(1)
merci pour vos conseils, je ne sais pas trop comment m'y prendre...:eek:

j'ai commencé un truc :
Code: 
Sub test()
    Dim myOlApp As New Outlook.Application
    Dim myNamespace As Outlook.NameSpace
    Dim myInbox As Outlook.MAPIFolder
    Dim myDestFolder As Outlook.MAPIFolder
    Dim myItems As Outlook.Items
  
    Set myNamespace = myOlApp.GetNamespace("MAPI")
    Set myInbox = myNamespace.GetDefaultFolder(olFolderInbox)
    Set myItems = myInbox.Items
      
    i = myInbox.Items.Count 'dernier message
    MsgBox myInbox.Items(i).Subject

End Sub

Sub Application_NewMail()
    Dim myOlApp As New Outlook.Application
    Dim myNamespace As Outlook.NameSpace
    Dim myInbox As Outlook.MAPIFolder
    Dim myDestFolder As Outlook.MAPIFolder
    Dim myItems As Outlook.Items
    Dim myItem As Object
    Set myNamespace = myOlApp.GetNamespace("MAPI")
    Set myInbox = myNamespace.GetDefaultFolder(olFolderInbox)
    Set myItems = myInbox.Items
    Set myDestFolder = myInbox.Folders("Temp")
    Dim strName As String

    For Each myItem In myInbox.Items
        strName = myItem.EntryID
        myItem.SaveAs "C:\temp\" & strName & ".txt", olTXT
        myItem.Move myDestFolder ' déplace
        Set myItem = myItems.GetNext
    Next myItem
End Sub

Private Sub Mails_contactsOutlook()
    Dim olApp As Outlook.Application
    Dim Cible As Outlook.ContactItem
    Dim Dossier As Outlook.MAPIFolder
    Dim Ns As Outlook.NameSpace
    Dim OLmail As Outlook.MailItem
    Dim NbJours As Long, DatePlusCinq As Date
    Dim an As Integer
    
    Set olApp = CreateObject("Outlook.Application")
    Set Ns = olApp.GetNamespace("MAPI")
   
    'balOutlook = Cells(2, 7).Value
    'Set Dossier = Ns.Folders(balOutlook).Folders("Prise en charge demande") 'Dossiers d'archivage, dossiers locaux, IMAP, BAL BANCILLON C, Dossiers Personnels, ArchivOulookBANCILLON, Dossiers d'archives, Dossiers publics
     Set myInbox = myNamespace.GetDefaultFolder(olFolderInbox)

NbJours = CLng(Date)
DatePlusCinq = CDate(NbJours + 5)

For Each OLmail In Dossier.Items
                a = Range("A" & Cells.Rows.Count).End(xlUp)(2, 1).Row
                id_courrier_arr
                Range("A" & a) = num_id_arrivé
                Range("B" & a) = OLmail.CreationTime
                Range("C" & a) = Date
                Range("D" & a) = OLmail.SenderName
                Range("F" & a) = OLmail.Subject
                Range("G" & a) = DatePlusCinq
                Range("R" & a) = DatePlusCinq + 42
Next OLmail
                'OLmail.Body
                End Sub
                
  Sub id_courrier_arr()
  Dim an_arr As Integer
  Dim incremen_arr As Variant
'recherche la derniére cellule non vide
    Range("A65536").End(xlUp).Select
'déconposition de l'id arrivé
   an_arr = Left(ActiveCell.Value, 4)
'   Stop
an = Year(Date)
   If an_arr <> an Then
      an_arr = Year(Date)
      incremen_arr = "00"
   Else
      incremen_arr = Right(ActiveCell.Value, Len(ActiveCell.Value) - 5)
   End If
   
   incremen_arr = incremen_arr + 1
   Do Until Len(incremen_arr) = 3
      incremen_arr = "0" & incremen_arr
   Loop
'incrémente la partie droite du num id
   num_id_arrivé = an_arr & "-" & incremen_arr
End Sub
                
Sub Archivage()
Dim olApp As Outlook.Application
    Dim myInbox As Outlook.MAPIFolder
    Dim Ns As Outlook.NameSpace
    Dim OLmail As Outlook.MailItem
    Dim NbJours As Long, DatePlusCinq As Date
    Dim an As Integer
    
    Set olApp = CreateObject("Outlook.Application")
    Set Ns = olApp.GetNamespace("MAPI")
   
    balOutlook = Cells(2, 7).Value
    Set Dossier = Ns.Folders(balOutlook).Folders("Prise en charge demande")
    Set Dossier2 = Dossier.Folders("suivi demandes")
    
    'si toute la ligne remplie alors archivage
                myInbox.Items(i).UnRead = False
                myInbox.Items(i).Move Dossier2
End Sub
        

Sub OuvrirExcel()
Dim appExcel As Excel.Application 'Application Excel
Dim wbExcel As Excel.Workbook 'Classeur Excel
Dim wsExcel As Excel.Worksheet 'Feuille Excel

'Ouverture de l'application Excel
Set appExcel = CreateObject("Excel.Application")
'Ouverture du classeur Excel
Set wbExcel = appExcel.Workbooks.Open("C:\MonFichierExcel.xls")
'wsExcel correspond à la première feuille du fichier
Set wsExcel = wbExcel.Worksheets(1)


'Fin de traitement
wbExcel.Close 'Fermeture du classeur Excel
appExcel.Quit 'Fermeture de l'application Excel

'Désallocation mémoire
Set wsExcel = Nothing
Set wbExcel = Nothing
Set appExcel = Nothing
End Sub

Sub Essai()
'Déclaration des Objets et variables
    Dim MonApply As Outlook.Application
    Dim MonMail As Outlook.MailItem
    Dim MonNSpace As Outlook.NameSpace
    Dim FldDossier As Outlook.MAPIFolder
    Dim strInfos As String

    'Instance des Objets
    Set MonApply = Outlook.Application    'Application Outlook
    Set MonNSpace = MonApply.GetNamespace("MAPI")    'Banque MAPI
    Set FldDossier = MonNSpace.GetDefaultFolder(olFolderInbox)    'Dossier boîte de réception
    'Initialisation de la chaîne de caractères
    strInfos = ""
    'Boucle afin de parcourir l'ensemble des E-mails présents dans le dossier Boîte de réception
    For i = 1 To FldDossier.Items.Count
        'instancie le mail suivant la valeur de la boucle
        Set MonMail = FldDossier.Items(i)
        'Récupère les diverses informations du Mail
            With MonMail
                'SenderEmailAddress
                'CreationTime
            End With
     Next i
 End Sub

Un grand Merci à vous

Bises

C@thy
 
Trier par date Trier par votes
C@thy

C@thy

XLDnaute Barbatruc
Re : traiter puis archiver les messages

Bonjour le forum,

comment ça va bien ce matin?

Il va faire très beau encore aujourd'hui.

Bon, pour en revenir à notre problème...

en faisant simple et sous Excel
ceci fonctionne à merveille :

Code: 
Public num_id_arrivé As String

Sub start()
With Application: .ScreenUpdating = False: .DisplayAlerts = False: End With
Mails_contactsOutlook
With Application: .ScreenUpdating = True: .DisplayAlerts = True: End With
End Sub

Private Sub Mails_contactsOutlook()
    Dim myOlApp As New Outlook.Application
    Dim Cible As Outlook.ContactItem
    Dim myInbox As Outlook.MAPIFolder
    Dim myDestFolder As Outlook.MAPIFolder
    Dim Ns As Outlook.NameSpace
    Dim OLmail As Outlook.MailItem
    Dim NbJours As Long, DatePlusCinq As Date
    Dim an As Integer
    Dim myItems As Outlook.Items
    
    Set olApp = CreateObject("Outlook.Application")
    Set Ns = olApp.GetNamespace("MAPI")
       
     v = Split(myInbox.FolderPath, "\") ''
     balOutlook = v(UBound(v) - 1) ''Boîte de réception
     Set myInbox = Ns.Folders(balOutlook).Folders("Prise en charge demande") 
     NbJours = CLng(Date)
     DatePlusCinq = CDate(NbJours + 5)

     For Each OLmail In myInbox.Items
                a = Range("A" & Cells.Rows.Count).End(xlUp)(2, 1).Row
                id_courrier_arr
                Range("A" & a) = num_id_arrivé
                Range("B" & a) = OLmail.CreationTime
                Range("C" & a) = Date
                Range("D" & a) = OLmail.SenderName
                Range("F" & a) = OLmail.Subject
                Range("G" & a) = DatePlusCinq
                Range("R" & a) = DatePlusCinq + 42
                'Archivage '***************************
     Next OLmail
                
                End Sub
                
  Sub id_courrier_arr()
  Dim an_arr As Integer
  Dim incremen_arr As Variant
'recherche la derniére cellule non vide
    Range("A65536").End(xlUp).Select
'déconposition de l'id arrivé
   an_arr = Left(ActiveCell.Value, 4)
'   Stop
an = Year(Date)
   If an_arr <> an Then
      an_arr = Year(Date)
      incremen_arr = "00"
   Else
      incremen_arr = Right(ActiveCell.Value, Len(ActiveCell.Value) - 5)
   End If
   incremen_arr = incremen_arr + 1
   Do Until Len(incremen_arr) = 3
      incremen_arr = "0" & incremen_arr
   Loop
'incrémente la partie droite du num id
   num_id_arrivé = an_arr & "-" & incremen_arr
End Sub
                
Sub Archivage()
Dim olApp As Outlook.Application
    Dim Cible As Outlook.ContactItem
    Dim myInbox As Outlook.MAPIFolder
    Dim myDestFolder As Outlook.MAPIFolder 'dossier de destination pour l'archivage
    Dim Ns As Outlook.NameSpace
    Dim OLmail As Outlook.MailItem
    Dim NbJours As Long, DatePlusCinq As Date
    Dim an As Integer
    Dim v as string

    Set olApp = CreateObject("Outlook.Application")
    Set Ns = olApp.GetNamespace("MAPI")
   
    v = Split(myInbox.FolderPath, "\") 
    balOutlook = v(UBound(v) - 1) 'Boîte de réception
    Set myInbox = Ns.Folders(balOutlook).Folders("Prise en charge demande")
    Set myDestFolder = myInbox.Folders("suivi demandes")
    myInbox.Items(1).UnRead = False
    myInbox.Items(1).Move myDestFolder
End Sub
Dès que j'enlève l'apostrophe de commentaire devant archivage (là où il y a les ********) il ne traite plus le dernier,
donc j'ai cerné le problème, cela vient du fait que je retire des mails de la boîte

J'ai oublié de préciser, mais ça se voit dans le code :
mon architecture est la suivante :
-Boîte aux lettres C@thy
-Prise en charge demande (au même niveau que Boîte de réception, Boîte d'envoi, courrier indésirable, Eléments envoyé Eléments supprimés)
-suivi demandes

J'ai donc 2 problèmes :

1- traiter puis archiver tous les messages de la boîte Prise en charge demande
2- porter cette macro sous Outlook

Merci à vous si vous pouvez m'aider, même partiellement

Bises et bonne journée

C@thy
 
Dernière édition:
Vote positif 0 Vote négatif
S

soune26

XLDnaute Junior
Re : traiter puis archiver les messages

salut cathy,

si ton sujet est toujour d'actualité peux tu telecharger le fichier ci-dessous , cliquer sur lister, enregistrer et le remettre sur ce post stp
car j'ai une petitie idée mais il me faut l'arborescence de ton outlook.
 

Pièces jointes

  • LISTER DOSSIER OUTLOOK.xls
    45.5 KB · Affichages: 178
  • LISTER DOSSIER OUTLOOK.xls
    45.5 KB · Affichages: 175
  • LISTER DOSSIER OUTLOOK.xls
    45.5 KB · Affichages: 175
Vote positif 0 Vote négatif
C@thy

C@thy

XLDnaute Barbatruc
Re : traiter puis archiver les messages

:):cool::)

Je poste ma soluce (c'est la version lonnnngue!)
Code: 
Sub AppliSousOutlook()
    'Déclaration des variables application
    Dim objOLApp As Outlook.Application
    Dim objXlApp As New Excel.Application   'Pour piloter l'application Excel
    Dim objXlClas As Excel.Workbook         'Pour piloter le classeur Excel
    Dim objwsExcel As Excel.Worksheet       'Pour piloter la Feuille Excel
    Dim objNS As Outlook.NameSpace          'Espace Outlook
    Dim objInbox As Outlook.MAPIFolder      'Boîte contenant les courriers Arrivée
    Dim objDestFolder As Outlook.MAPIFolder 'Boîte pour Archivage
    Dim OLmail As Outlook.MailItem          'courrier
    'Déclaration des variables locales
    Dim nbJours As Long
    Dim an As Integer
    Dim I As Integer
    Dim N As Long, fr, v
    Dim AdressMail As String, Service As String
    Dim sNomLDAP As String
    
    On Error GoTo fin
    
    'Instanciations
    Set objOLApp = CreateObject("Outlook.Application")
    Set objXlApp = CreateObject("Excel.Application")
    Set objNS = objOLApp.GetNamespace("MAPI")
    Set objInbox = objNS.GetDefaultFolder(olFolderInbox) 'Boîte de réception
         v = Split(objInbox.FolderPath, "\")
         balOutlook = v(UBound(v) - 1) 'découpage chemin Boîte de réception
    Set objInbox = objNS.Folders(balOutlook).Folders("Prise en charge demande")
    Set objDestFolder = objInbox.Folders("suivi demandes")

    'Ouverture du classeur
    Set objXlClas = objXlApp.Workbooks.Open("W:\TestOutlook.xls")
      'initialisation des variables locales
    an = Year(Date)
    fr = Fer(an)
    N = CLng(Date) + 1
   
   For Each OLmail In objInbox.Items
       With objXlClas.Worksheets(1) '1ère Feuille du classaur
           a = .Range("A65536").End(-4162).row + 1
           'décomposition de l'id arrivé
           an_arr = Left(.Range("A" & a - 1).Value, 4)
           an = Year(Date)
           If an_arr < an Then
              an_arr = Year(Date)
              incremen_arr = "00"
           Else
              incremen_arr = Right(.Range("A" & a - 1), 3)
           End If
           incremen_arr = incremen_arr + 1
           Do Until Len(incremen_arr) = 3
                incremen_arr = "0" & incremen_arr
           Loop
'incrémente la partie droite du num id
           num_id_arrivé = an_arr & "-" & incremen_arr
           .Range("A" & a).Value = num_id_arrivé
           .Range("B" & a).Value = OLmail.CreationTime
           .Range("C" & a).Value = Date
           .Range("D" & a).Value = OLmail.SenderName
           AdressMail = OLmail.SenderEmailAddress 
           ident = Mid(AdressMail, 4, InStr(AdressMail, "-ADC"))
           v = Split(Replace(Replace(AdressMail, "=", "/"), "-ADC", "/"), "/")
           ident = v(UBound(v) - 1) & "-ADC"
           'connexion à l'Annuaire LDAP
           Set rs = CreateObject("ADODB.Recordset")
           conn = "Provider=ADSDSOObject"
           attrs = "adspath"
           filtre = "(uid=" & ident & ")"
           dom = "ou=centrale,ou=mefi,o=gouv,c=fr"
           req = "<LDAP://proxyldap.alize/" & dom & ">;" & filtre & ";adspath;subtree"
           rs.Open req, conn
           While Not rs.EOF
                 Set titi = GetObject(rs("adspath"))
                 'sNomLDAP = titi.Get("CN") 'Nom prenom
                 'MsgBox sNomLDAP 'afficher nom prenom
                 Service = titi.Get("ouSigle")
                 v = Split(Replace(Replace(AdressMail, "=", "/"), "-ADC", "/"), "/")
                 ident = v(UBound(v) - 1)
                 .Range("E" & a).Value = ident
                 rs.MoveNext
           Wend
           .Range("F" & a).Value = OLmail.Subject
           N = AJouteJoursOuvrés(Date, 5, fr)
           .Range("G" & a).Value = CDate(N)
           N = AJouteJoursOuvrés(Date, 30, fr)
           .Range("R" & a).Value = CDate(N)
           OLmail.Move objDestFolder
        End With
        rs.Close
        Set rs = Nothing
Next OLmail 
fin:
    'On ferme le fichier Excel
     objXlClas.Close True
    'On quitte Excel
     objXlApp.Quit
    'On libère les ressources
     Set objXlClas = Nothing
     Set objXlApp = Nothing
End Sub
  
Function AJouteJoursOuvrés(ByVal d As Long, nbJours As Integer, Fer As Variant) As Long 'calcul ajout de jours ouvrés
    Dim I As Integer, bAjoute As Boolean
    'StrFériés contiendra une chaine de tous les jours fériés séparés par un point virgule
    Dim strFériés As String: strFériés = Join(Fer, ";")
    For I = 1 To nbJours
        d = d + 1
        'Si d est un dimanche ou Samedi ou s'il est trouvé dans strFériés alors ajourter un jour
        Do While Weekday(d) = 1 Or Weekday(d) = 7 Or InStr(1, strFériés, CStr(d) & ";") > 0
            d = d + 1
        Loop
    Next I
    AJouteJoursOuvrés = d
End Function

Function Paq(ByVal an As Integer) As Date
Paq = CLng(DateSerial(an, 3, 23)) + ((2 * (an Mod 4) + (4 * (an Mod 7) + _
   (6 * (((19 * (an Mod 19)) + 24) Mod 30) + 5))) Mod 7) + _
   ((19 * (an Mod 19) + 24) Mod 30) - 1
End Function

Function Fer(an%) 'liste de tous les jours fériés
Dim pq
pq = Paq(an)
Fer = Array(CLng(DateSerial(an, 1, 1)), CLng(DateSerial(an, 5, 1)), CLng(DateSerial(an, 5, 8)), CLng(DateSerial(an, 7, 14)), CLng(DateSerial(an, 8, 15)), CLng(DateSerial(an, 11, 1)), CLng(DateSerial(an, 11, 11)), CLng(DateSerial(an, 12, 25)), CLng(pq) + 1, CLng(pq) + 39, CLng(pq) + 50)
End Function
Bises

C@thy
 
Dernière édition:
Vote positif 0 Vote négatif
C@thy

C@thy

XLDnaute Barbatruc
Re : traiter puis archiver les messages

Bonjour le Soune26, fil, le forum,

Le fichier de Soune26 permet de lister tous les dossiers et leurs sous-dossiers.

J'ai essayé de le compléter pour lister aussi les sous-sous-dossiers, mais je sors en erreur.

Quelqu'un(e) aurait une idée? (merci Soune26, ton exemple est très bien)

Bises

C@thy
 
Vote positif 0 Vote négatif
S

soune26

XLDnaute Junior
Re : traiter puis archiver les messages

salut c@thy ,le fil et le fofo,

tu cherche à trouver quoi exactement?
-si il y a des dossier dans les sous dossier (c'est à dire comme tu le dis des sousousdossier)
ou
-tous ce qui ce trouve dans un dossier (du style un RDV dans un calandrier,un mail, un contact)
 
Vote positif 0 Vote négatif
S

soune26

XLDnaute Junior
Re : traiter puis archiver les messages

Re,

Voilà C@thy, j'ai essayé de faire ce que je peux, donc avec mes rectifications sur mon ancienne version on obtien tous ce qui ce trouve dans outlook je pense que d'avoir plus d'info serait difficile.

Dis moi ce que tu en pense.

J'utilse cette methode pour pouvoir modifier, supprimer, ou ajouter des RDV sur mes 40 calendrier partager sur Hotmail!!!

Bizzzz
 

Pièces jointes

  • LISTER%20DOSSIER%20OUTLOOK(1).xls
    47 KB · Affichages: 154
  • LISTER%20DOSSIER%20OUTLOOK(1).xls
    47 KB · Affichages: 155
  • LISTER%20DOSSIER%20OUTLOOK(1).xls
    47 KB · Affichages: 158
Dernière édition:
Vote positif 0 Vote négatif
C@thy

C@thy

XLDnaute Barbatruc
Re : traiter puis archiver les messages

Bonjour soune26

un grand merci pour ta réponse

ton exemple me va bien, c'est l'idée, à un détail près :

s'il n'y a pas de sous-sous dossier je ne veux pas lister les mails,

juste lister tous les dossiers et leurs sous-dossiers, sous-sous-dossiers

voir ce fil

Merciiiii

Bises

C@thy
 
Dernière édition:
Vote positif 0 Vote négatif

Discussions similaires

gothc
  • Question
XL 2021 choisir un onglet avant envoyer par email
Réponses
2
Affichages
344
gothc
gothc
O
  • Question
Microsoft 365 Excel [VBA]. Erreur d’exécution 424 Objet requis sur une concaténation
Réponses
3
Affichages
157
Oneida
Oneida
L
  • Question
Microsoft 365 vba Outlook traiter un fichier excel lors de sa reception
Réponses
0
Affichages
269
lesoldat9
L
F
  • Résolu(e)
XL 2016 Envoi mail fichier Excel renommer
Réponses
6
Affichages
576
FS69
F
K
  • Question
Microsoft 365 Macro VBA
Réponses
2
Affichages
418
fanch55
fanch55
ELSONCe
  • Question
Microsoft 365 Envoi Mail Automatique avec Condition
Réponses
2
Affichages
548
ELSONCe
ELSONCe
C
  • Question
Microsoft 365 Erreur Automation : L'objet invoqué s'est déconnecté de ses clients
Réponses
9
Affichages
1 K
fanch55
fanch55
C
  • Question
XL 2019 Atteindre depuis excel plusieurs calendriers partagé outlook de destination
Réponses
2
Affichages
729
chich
C
M
  • Question
XL 2013 VBA-Envoyer par email "Plage de cellules collée dans un nouveau classeur en gardant formules de certaines cellules
Réponses
2
Affichages
686
MONTREAL2020
M
E
  • Question
XL 2013 Ajouter un rdv calendrier depuis excel via exchange
Réponses
0
Affichages
817
estivill
E

Membres actuellement en ligne

16 membres et 344 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 234
Messages
2 086 475
Membres
103 226
dernier inscrit
smail12