1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40
|
Sub GetSenderFromCurrentFolder()
Dim MonOutlook As Outlook.Application
Dim LesMails As Object
'Déclaration des variables
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
Set appExcel = CreateObject("Excel.Application")
appExcel.Visible = True
appExcel.Workbooks.Add
Set wbExcel = appExcel.ActiveWorkbook
Set wsExcel = wbExcel.ActiveSheet
wsExcel.Range("a1").Value = "Mail"
Dim ligne
ligne = 2
Set MonOutlook = Outlook.Application
Set LesMails = MonOutlook.ActiveExplorer.Selection
If LesMails.Count <= 1 Then
toutmails = MsgBox("Selectionner tous les mails du dossier ?", vbYesNo, "pour recherche des adresses Email")
If toutmails = vbYes Then
Set LesMails = MonOutlook.ActiveExplorer.CurrentFolder.Items
End If
End If
For Each lemail In LesMails
wsExcel.Cells(ligne, 1).Value = lemail.SenderEmailAddress
ligne = ligne + 1
Next lemail
MsgBox "Opération terminée"
End Sub |
Partager