Bonjour,
J'ai besoin de récupérer des infos de mails contenus sous Outlook et d'enregistrer ces infos dans un fichier Excel.
Mon soucis est que lorsque j’exécute la macro, elle parcourt tous les mails et non pas que les nouveaux => je me trouve avec des doublons,.....
Voici la macro :
De plus en éxécutant la macro, j'ai le message d'erreur suivant :
'Erreur d'execution "1004" : La méthode Sort de la classe Range a échoué.
Lorsque je clique sur Débogage, il mentionne la ligne que j'ai mis en bleue.
Que cela signifie t il ?
En vous remerciant pour votre aide.
PS : je vous joins le fichier
J'ai besoin de récupérer des infos de mails contenus sous Outlook et d'enregistrer ces infos dans un fichier Excel.
Mon soucis est que lorsque j’exécute la macro, elle parcourt tous les mails et non pas que les nouveaux => je me trouve avec des doublons,.....
Voici la macro :
Private Sub Mails_contactsOutlook()
Dim olApp As Outlook.Application
Dim Cible As Outlook.ContactItem
Dim dossierContacts As Outlook.MAPIFolder
Dim Dossier As Outlook.MAPIFolder
Dim Ns As Outlook.Namespace
Set olApp = New Outlook.Application
Set dossierContacts = olApp.GetNamespace("MAPI").GetDefaultFolder(olFolderContacts)
Set Ns = olApp.GetNamespace("MAPI")
Set Dossier = Ns.Folders("yann.teule@transport.alstom.com").Folders("Projets").Folders("04 - Panama")
SearchFolders Dossier
End Sub
Private Sub SearchFolders(ByVal Fld As Outlook.MAPIFolder)
Dim OLmail As Outlook.MailItem
Dim SousDossier As Outlook.MAPIFolder
Dim c As Range, start As Long, trouv As Long, msg As String
On Error Resume Next
For Each SousDossier In Fld.Folders
If SousDossier.Name = "y - ACONEX" Then
For Each OLmail In SousDossier.Items
a = Range("C" & Cells.Rows.Count).End(xlUp)(2, 1).Row
Range("C" & a) = OLmail.CreationTime
'Range("B" & a) = OLmail.SenderName
Range("E" & a) = OLmail.Subject
'Range("D" & a) = OLmail.Body
Next OLmail
SearchFolders SousDossier
End If
Next SousDossier
End Sub
Sub start()
If [A2] <> "" Then Range("A2:B" & Range("B" & Cells.Rows.Count).End(xlUp).Row).Clear
With Application: .ScreenUpdating = False: .DisplayAlerts = False: End With
Mails_contactsOutlook
[A2].Sort Key1:=[A2], Order1:=xlAscending, Key2:=[B2], Order2:=xlAscending, Header:=xlYes
With Application: .ScreenUpdating = True: .DisplayAlerts = True: End With
End Sub
Dim olApp As Outlook.Application
Dim Cible As Outlook.ContactItem
Dim dossierContacts As Outlook.MAPIFolder
Dim Dossier As Outlook.MAPIFolder
Dim Ns As Outlook.Namespace
Set olApp = New Outlook.Application
Set dossierContacts = olApp.GetNamespace("MAPI").GetDefaultFolder(olFolderContacts)
Set Ns = olApp.GetNamespace("MAPI")
Set Dossier = Ns.Folders("yann.teule@transport.alstom.com").Folders("Projets").Folders("04 - Panama")
SearchFolders Dossier
End Sub
Private Sub SearchFolders(ByVal Fld As Outlook.MAPIFolder)
Dim OLmail As Outlook.MailItem
Dim SousDossier As Outlook.MAPIFolder
Dim c As Range, start As Long, trouv As Long, msg As String
On Error Resume Next
For Each SousDossier In Fld.Folders
If SousDossier.Name = "y - ACONEX" Then
For Each OLmail In SousDossier.Items
a = Range("C" & Cells.Rows.Count).End(xlUp)(2, 1).Row
Range("C" & a) = OLmail.CreationTime
'Range("B" & a) = OLmail.SenderName
Range("E" & a) = OLmail.Subject
'Range("D" & a) = OLmail.Body
Next OLmail
SearchFolders SousDossier
End If
Next SousDossier
End Sub
Sub start()
If [A2] <> "" Then Range("A2:B" & Range("B" & Cells.Rows.Count).End(xlUp).Row).Clear
With Application: .ScreenUpdating = False: .DisplayAlerts = False: End With
Mails_contactsOutlook
[A2].Sort Key1:=[A2], Order1:=xlAscending, Key2:=[B2], Order2:=xlAscending, Header:=xlYes
With Application: .ScreenUpdating = True: .DisplayAlerts = True: End With
End Sub
De plus en éxécutant la macro, j'ai le message d'erreur suivant :
'Erreur d'execution "1004" : La méthode Sort de la classe Range a échoué.
Lorsque je clique sur Débogage, il mentionne la ligne que j'ai mis en bleue.
Que cela signifie t il ?
En vous remerciant pour votre aide.
PS : je vous joins le fichier