Je souhaite trouver un moyen d'extraire les mails d'outlook pour les
envoyer vers excel.
Cependant ces mails se trouvent dans des sous dossiers de la boites
de
receptions portant comme noms :
- Litiges
- Satisfecits
J'ai la commande suivante :
Private Sub CommandButton3_Click()
Set olApp = CreateObject("Outlook.Application")
Set olns = olApp.GetNamespace("MAPI")
Set olxFolder = olns.GetDefaultFolder(6)
Sheets("RecupMSG").Select
On Error Resume Next
n = 2
For Each i In olxFolder.items
Cells(n, 1) = i.Subject
Cells(n, 2).ClearComments
Cells(n, 1).Comment.Shape.Height = 50
Cells(n, 1).Comment.Shape.Width = 50
Cells(n, 6) = i.SenderName
Cells(n, 7) = i.CreationTime
n = n + 1
Next
End Sub
Mais forcement il m'extrait les messages de la boite de reception.
Je sais que c'est la ligne : Set olxFolder =
olns.GetDefaultFolder(6)
mais je ne sais pas par quoi la remplacer, malgres mes essais ....
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire
Veuillez sélectionner un problème
Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Corto
Bonjour il faut parcourir l'arborescence des folders :
Set XOUTLOOK = CreateObject("Outlook.Application") Set XMAPI = XOUTLOOK.GetNamespace("MAPI")
For Each XMAILFOLDER In XMAPI.Folders If Left(XFOLDER.Name, 17) = "Boîte aux lettres" Then For Each XFOLDER In XMAILFOLDER.Folders Worksheets.Add ActiveSheet.Name = XFOLDER.Name XNBMSG = 1 For Each XMSG In XFOLDER.Items Cells(XNBMSG + 1, 1) = XMSG.Subject Cells(XNBMSG + 1, 2) = XMSG.SenderName Cells(XNBMSG + 1, 3) = XMSG.CreationTime If XMSG.UnRead Then Range(Cells(XNBMSG + 1, 1), Cells(XNBMSG + 1, 3)).Font.Bold = True End If
XNBMSG = XNBMSG + 1 Next XMSG Next XFOLDER End If Next XMAILFOLDER
Corto
Bonjour,
Je souhaite trouver un moyen d'extraire les mails d'outlook pour les envoyer vers excel. Cependant ces mails se trouvent dans des sous dossiers de la boites de receptions portant comme noms : - Litiges - Satisfecits
J'ai la commande suivante :
Private Sub CommandButton3_Click() Set olApp = CreateObject("Outlook.Application") Set olns = olApp.GetNamespace("MAPI") Set olxFolder = olns.GetDefaultFolder(6) Sheets("RecupMSG").Select On Error Resume Next n = 2 For Each i In olxFolder.items Cells(n, 1) = i.Subject Cells(n, 2).ClearComments Cells(n, 1).Comment.Shape.Height = 50 Cells(n, 1).Comment.Shape.Width = 50 Cells(n, 6) = i.SenderName Cells(n, 7) = i.CreationTime n = n + 1 Next End Sub
Mais forcement il m'extrait les messages de la boite de reception.
Je sais que c'est la ligne : Set olxFolder > olns.GetDefaultFolder(6)
mais je ne sais pas par quoi la remplacer, malgres mes essais ....
Quelqun peut il m'aider sur ce point ?
Merci d'avance
Jer
Bonjour
il faut parcourir l'arborescence des folders :
Set XOUTLOOK = CreateObject("Outlook.Application")
Set XMAPI = XOUTLOOK.GetNamespace("MAPI")
For Each XMAILFOLDER In XMAPI.Folders
If Left(XFOLDER.Name, 17) = "Boîte aux lettres" Then
For Each XFOLDER In XMAILFOLDER.Folders
Worksheets.Add
ActiveSheet.Name = XFOLDER.Name
XNBMSG = 1
For Each XMSG In XFOLDER.Items
Cells(XNBMSG + 1, 1) = XMSG.Subject
Cells(XNBMSG + 1, 2) = XMSG.SenderName
Cells(XNBMSG + 1, 3) = XMSG.CreationTime
If XMSG.UnRead Then
Range(Cells(XNBMSG + 1, 1), Cells(XNBMSG + 1,
3)).Font.Bold = True
End If
XNBMSG = XNBMSG + 1
Next XMSG
Next XFOLDER
End If
Next XMAILFOLDER
Corto
Bonjour,
Je souhaite trouver un moyen d'extraire les mails d'outlook pour les
envoyer vers excel.
Cependant ces mails se trouvent dans des sous dossiers de la boites
de
receptions portant comme noms :
- Litiges
- Satisfecits
J'ai la commande suivante :
Private Sub CommandButton3_Click()
Set olApp = CreateObject("Outlook.Application")
Set olns = olApp.GetNamespace("MAPI")
Set olxFolder = olns.GetDefaultFolder(6)
Sheets("RecupMSG").Select
On Error Resume Next
n = 2
For Each i In olxFolder.items
Cells(n, 1) = i.Subject
Cells(n, 2).ClearComments
Cells(n, 1).Comment.Shape.Height = 50
Cells(n, 1).Comment.Shape.Width = 50
Cells(n, 6) = i.SenderName
Cells(n, 7) = i.CreationTime
n = n + 1
Next
End Sub
Mais forcement il m'extrait les messages de la boite de reception.
Je sais que c'est la ligne : Set olxFolder > olns.GetDefaultFolder(6)
mais je ne sais pas par quoi la remplacer, malgres mes essais ....
Bonjour il faut parcourir l'arborescence des folders :
Set XOUTLOOK = CreateObject("Outlook.Application") Set XMAPI = XOUTLOOK.GetNamespace("MAPI")
For Each XMAILFOLDER In XMAPI.Folders If Left(XFOLDER.Name, 17) = "Boîte aux lettres" Then For Each XFOLDER In XMAILFOLDER.Folders Worksheets.Add ActiveSheet.Name = XFOLDER.Name XNBMSG = 1 For Each XMSG In XFOLDER.Items Cells(XNBMSG + 1, 1) = XMSG.Subject Cells(XNBMSG + 1, 2) = XMSG.SenderName Cells(XNBMSG + 1, 3) = XMSG.CreationTime If XMSG.UnRead Then Range(Cells(XNBMSG + 1, 1), Cells(XNBMSG + 1, 3)).Font.Bold = True End If
XNBMSG = XNBMSG + 1 Next XMSG Next XFOLDER End If Next XMAILFOLDER
Corto
Bonjour,
Je souhaite trouver un moyen d'extraire les mails d'outlook pour les envoyer vers excel. Cependant ces mails se trouvent dans des sous dossiers de la boites de receptions portant comme noms : - Litiges - Satisfecits
J'ai la commande suivante :
Private Sub CommandButton3_Click() Set olApp = CreateObject("Outlook.Application") Set olns = olApp.GetNamespace("MAPI") Set olxFolder = olns.GetDefaultFolder(6) Sheets("RecupMSG").Select On Error Resume Next n = 2 For Each i In olxFolder.items Cells(n, 1) = i.Subject Cells(n, 2).ClearComments Cells(n, 1).Comment.Shape.Height = 50 Cells(n, 1).Comment.Shape.Width = 50 Cells(n, 6) = i.SenderName Cells(n, 7) = i.CreationTime n = n + 1 Next End Sub
Mais forcement il m'extrait les messages de la boite de reception.
Je sais que c'est la ligne : Set olxFolder > olns.GetDefaultFolder(6)
mais je ne sais pas par quoi la remplacer, malgres mes essais ....
