Re : creer un fichier excel à partir de données envoyées par mail (outlook)
Bonjour
Voici le code que j'ai (copie du code de Softmama) :
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("Projets").Folders("Process") " ça bloque ici car il ne trouve pas le répertoire !!??" 😡
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 UCase(SousDossier.Name) = "Process" Then
For Each OLmail In SousDossier.Items
a = Range("A" & Cells.Rows.Count).End(xlUp)(2, 1).Row
Range("A" & a) = OLmail.Subject
Range("B" & a) = OLmail.SenderName
Range("C" & a) = OLmail.CreationTime
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