Bonjour,
Je souhaite scanner les mails d'une boite générique sous Outlook, en VBA.
J'y arrive très lorsque que je dois scanner ma boite mail pro, mais pas sur une boite générique auquel j'ai accès.
J'ai chercher sur différents forum et différents moteur de recherche, mais je n'ai rien trouvé.
Savez vous s'il est possible de le faire ?
Ci joint le code que j'utilise pour scanner ma boite pro, j'ai naïvement penser qu'il suffisait de mettre l'adresse mail de la boite générique à la place de la mienne.
Merci pour votre aide
Sub Enregistreobjetmail()
'Enregistre l'objet d'un mail et récupère la date
'Sélectionner auparavant l'option : OUTILS -Référence - Microsoft Outlook ...Library
Dim Base As Workbook
Dim BDD As Worksheet
Dim Test As String
Set Base = ThisWorkbook
Set BDD = Base.Worksheets("BDD")
Contact = "monadressepro@domaine.fr"
'Contact = Range("Z1")
'Enleve les message d'alerte
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'Déclarations
Dim olApp As Object
Dim NS As Object
Dim dossier As Object
Dim dossier2 As Object
Dim i As Object
Dim pceJointe As Outlook.Attachment
Dim Tour As Integer
'Affectations
Set olApp = CreateObject("Outlook.Application") 'L'applicatif Outlook
Set NS = olApp.GetNamespace("MAPI") 'Les noms des dossiers
'Le 1er dossier de la boîte de réception
Set dossier = NS.Folders(Contact).Folders("Boîte de réception") '.Folders("A traiter")
'Set Dossier = NS.Folders(1).Folders("Boîte de réception").Folders(1)
On Error Resume Next
Set dossier2 = NS.Folders(Contact).Folders("Boîte de réception")
Dim myNewFolder As MAPIFolder
Set myNewFolder = dossier2.Folders.Add("Archive résa Mobicar")
Set dossier2 = NS.Folders(Contact).Folders("Boîte de réception") '.Folders("Archive résa Mobicar")
'Pour chaque mail dans l'ensemble des mails du dossier
Tour = 1
For Each i In dossier.Items
If i.SenderName = "noreply@chevincomputers.com" Then
'Range("K1") = i.Subject
Test = InStr(i.Subject, "[Mobicar] Réservation approuvée :")
If Test <> 0 Then
BDD.Range("A" & Tour) = i.Subject 'affiche l'objet du mail
BDD.Range("B" & Tour) = i.Body 'affiche le corps du mail
Tour = Tour + 1
'i.Move dossier2
End If
End If
Next
If BDD.Range("A1") = "" Then
Exit Sub
Else
Call Recup_info_mail
End If
'Enleve les message d'alerte
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Je souhaite scanner les mails d'une boite générique sous Outlook, en VBA.
J'y arrive très lorsque que je dois scanner ma boite mail pro, mais pas sur une boite générique auquel j'ai accès.
J'ai chercher sur différents forum et différents moteur de recherche, mais je n'ai rien trouvé.
Savez vous s'il est possible de le faire ?
Ci joint le code que j'utilise pour scanner ma boite pro, j'ai naïvement penser qu'il suffisait de mettre l'adresse mail de la boite générique à la place de la mienne.
Merci pour votre aide
Sub Enregistreobjetmail()
'Enregistre l'objet d'un mail et récupère la date
'Sélectionner auparavant l'option : OUTILS -Référence - Microsoft Outlook ...Library
Dim Base As Workbook
Dim BDD As Worksheet
Dim Test As String
Set Base = ThisWorkbook
Set BDD = Base.Worksheets("BDD")
Contact = "monadressepro@domaine.fr"
'Contact = Range("Z1")
'Enleve les message d'alerte
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'Déclarations
Dim olApp As Object
Dim NS As Object
Dim dossier As Object
Dim dossier2 As Object
Dim i As Object
Dim pceJointe As Outlook.Attachment
Dim Tour As Integer
'Affectations
Set olApp = CreateObject("Outlook.Application") 'L'applicatif Outlook
Set NS = olApp.GetNamespace("MAPI") 'Les noms des dossiers
'Le 1er dossier de la boîte de réception
Set dossier = NS.Folders(Contact).Folders("Boîte de réception") '.Folders("A traiter")
'Set Dossier = NS.Folders(1).Folders("Boîte de réception").Folders(1)
On Error Resume Next
Set dossier2 = NS.Folders(Contact).Folders("Boîte de réception")
Dim myNewFolder As MAPIFolder
Set myNewFolder = dossier2.Folders.Add("Archive résa Mobicar")
Set dossier2 = NS.Folders(Contact).Folders("Boîte de réception") '.Folders("Archive résa Mobicar")
'Pour chaque mail dans l'ensemble des mails du dossier
Tour = 1
For Each i In dossier.Items
If i.SenderName = "noreply@chevincomputers.com" Then
'Range("K1") = i.Subject
Test = InStr(i.Subject, "[Mobicar] Réservation approuvée :")
If Test <> 0 Then
BDD.Range("A" & Tour) = i.Subject 'affiche l'objet du mail
BDD.Range("B" & Tour) = i.Body 'affiche le corps du mail
Tour = Tour + 1
'i.Move dossier2
End If
End If
Next
If BDD.Range("A1") = "" Then
Exit Sub
Else
Call Recup_info_mail
End If
'Enleve les message d'alerte
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
