Afficher le mail recherché et le transférer via VBA

Candy -  
 Candy -
Bonjour à vous.

Merci pour ce que vous faites pour les novices comme nous.

J'ai un soucis. Je chercher à afficher un mail Outlook et à le transférer via VBA.

En fait j'ai un tableau de données qui renferme, le nom des compagnies, et les numéros des factures émises.

les deux ensembles constitue l'objet du mail à envoyer.

Le travail que je fais à mon niveau est le suivant.

- Je sélectionne le nom de la compagnie dans mon fichier excel.
- la macro récupère le nom et le numéro de la facture dans deux variables,
- une troisième variable forme l'objet du mail,
- ensuite la macro va sur outlook et tente de retrouver le mail dont le sender est connu et l'objet correspond à la troisième variable.
- si le mail est trouvé, un message devra s'afficher.

Voici mon code:

---------------------------------------------------------------------------------------------------------------------------

Sub recherchemail()

Dim Dossier As Folder
Dim MonApp As Outlook.Application
Dim MonMail As Object, lesmails As Object
Dim ns As Object
Dim i As Object
Dim b As Integer
Dim j As Integer
Dim wbra As Workbook
Dim wsud As Worksheet
Dim lrow As Integer
Dim rngco As Range
Dim rnginv As Range
Dim R As Range
Dim data As Variant
Dim senderemail1 As String
Dim objectemail As String

'------------------------------------- recuperation d l'objet du mail--------------------------------------------
Set wbra = ActiveWorkbook
Set wsud = wbra.Worksheets("Unpaid_details")

For Each R In Selection

lrow = R.Row
Set rngco = wsud.Range("C" & lrow)
Set rnginv = wsud.Range("G" & lrow)
data = rngco & ("- Oustanding Inv. n°") & rnginv

Next R

'------------------------------comparaison email et objet avec emailadresse et objet dans outlook------------------------------------------------

On Error Resume Next: Set MonApp = GetObject(, "Outlook.Application"): On Error GoTo 0
If MonApp Is Nothing Then Set MonApp = CreateObject("Outlook.Application")
Set ns = MonApp.GetNamespace("MAPI")
Set Dossier = ns.Folders("Accounting").Folders("Boîte de réception").Folders("UNPAID")
Set lesmails = Dossier.Items

'MsgBox "Le Dossier est " & Dossier.Name & " || Nombre de Mails : " & lesmails.Count

j = lesmails.Count
For b = j To 1 Step -1
Set i = lesmails(b)
senderemail1 = i.SenderEmailAddress
objectemail = i.Subject
If senderemail1 = "***@***" And objectemail = data Then
MsgBox "mail trouvé"
Set MonMail = i.Forward

Exit For
End If

End Sub

--------------------------------------------------------------------------------------------------------------------------------------------------------------------

le problème est que déjà, la recherche dans Outlook ne se fait pas dans l'ordre des message ( du dernier mail au premier mail), il y a des sauts de recherche ( il commence à partir du dernier mail, se retrouve subitement au 300 eme mail par exemple, revient au 5 eme mail .etc...) et a un certain moment, un message d'erreur s'affiche ( Erreur 438" cet objet ne gère pas cette propriété ou méthode)

l'erreur apparaît au niveau de la ligne soulignée. mais au niveau de la ligne au dessus (le paramètre souligné) il n'y a rien qui s'affiche, c'est comme si le mail n'existe pas.

Je ne sais pas comment le régler.

Si vous avez une piste ça serait formidable.

Merci beaucoup

1 réponse

  1. yg_be Messages postés 23437 Date d'inscription   Statut Contributeur Dernière intervention   Ambassadeur 1 588
     
    bonjour, suggestion:
    Dim ittem As Object, message As MailItem
    
    For Each ittem In Dossier.Items
        If ittem.Class = olMail Then
            Set message = ittem
            senderemail1 = message.SenderEmailAddress
            objectemail = message.Subject
            If senderemail1 = "***@***" And objectemail = data Then
                MsgBox "mail trouvé"
                Set MonMail = message.Forward
                Exit For
            End If
        End If
    Next ittem
    1
    1. Candy
       
      Merci beaucoup, je vais essayer
      0