Mettre le mail comme "Lu" sur Outlook

Le 06/02/2022 à 00:57

Bonsoir à tous,

J'ai une macro qui me permets de lire des mails "non lus" dans un dossier en particulier de ma boite outlook:

image

En effet ma macro va venir me récupérer, le rendement, le prix, la quantité, et venir alimenter mon fichier de suivi.

mon code est le suivant:

Sub LireMessages()
Dim olapp As Outlook.Application
Set olapp = New Outlook.Application
Dim NS As Object, Dossier As Object
Dim OlExp As Object
Dim i As Object
Dim mybody() As String
Dim fromsender() As String
Dim prelevement As Date
Dim montant As Variant
'Dim traitement As Integer

ThisWorkbook.Activate
'Worksheets("Extraction").Activate
Nbligne = Range("C65536").End(xlUp).Row

Set NS = olapp.GetNamespace("MAPI")
Set Dossier = NS.GetDefaultFolder(olFolderInbox).Folders("VCON BLOOM")
b = Nbligne + 1

For Each i In Dossier.Items
fromsender = Split(i.SenderEmailAddress, "@")
If i.SenderEmailType <> "EX" Then
sujet = i.Subject
'blntmsgusr@bloomberg.net
    If i.UnRead And fromsender(1) = "bloomberg.net" Then
        sujet = i.Subject
        mybody = Split(i.Body, vbCrLf)

     'REINITIALISATION DES VARIABLES PASSAGE

   Tri_passage = 0
    prix_passage = 0
    montant_passage = 0
     qte_passage = 0
      montant_passage = 0
      Isin_passage = 0
      Issue_passage = 0
      Settle_date_passage = 0
      Sens_passage = 0
      coupon_passage = 0
    '    dejafait = True
       ' dejafait2 = True
        For compt = 0 To UBound(mybody)

        'TRA
            If Tri_passage <> 1 Then
            If InStr(1, UCase(mybody(compt)), UCase("Yield")) > 0 Then
                TRI = Trim(Split(mybody(compt), ":")(2))
                Tri_passage = Tri_passage + 1
            End If
            End If

            'trade_date probleme format ricain (1er passage)
            If InStr(1, UCase(mybody(compt)), UCase("Trade Date")) > 0 = True Then
                trade_date = Trim(Split(mybody(compt), ":")(2))
               ' trade_date = Format(WorksheetFunction.WorkDay(trade_date, 3), "dd/mm/yyyy")
                dejafait = False
            End If

            'prix_oblig (1er passage)
            If prix_passage <> 1 Then
            If InStr(1, UCase(mybody(compt)), UCase("Price")) > 0 Then
               Price = Trim(Split(mybody(compt), ":")(1))
               Price = Split(Price, "Yield")
               Price = Trim(Price(0))
               prix_passage = prix_passage + 1
            End If
            End If

            'Net probleme de format de nombre (1er passage)
            If montant_passage <> 1 Then
            If InStr(1, UCase(mybody(compt)), UCase("Net")) > 0 Then
                montant = Trim(Split(mybody(compt), ":")(1))
                montant = Split(montant, " ", 2)
                montant_passage = montant_passage + 1
         '       montant = Format(montant, "##,##0.00")
            montant = montant(0)
             '   MsgBox (montant(0))
            '    dejafait2 = False
            End If
            End If
     'valeur_nominal (1er passage)
     If qte_passage <> 1 Then
            If InStr(1, UCase(mybody(compt)), UCase("Quantity")) > 0 Then
           Qte = Trim(Split(mybody(compt), ":")(2))
           qte_passage = qte_passage + 1
            End If
            End If

            'ISIN
            If Isin_passage <> 1 Then
              If InStr(1, UCase(mybody(compt)), UCase("ISIN")) > 0 Then
             ISIN = Trim(Split(mybody(compt), ":")(1))
             Isin_passage = Isin_passage + 1
         End If
         End If

          'Issue
            If Issue_passage <> 1 Then
              If InStr(1, UCase(mybody(compt)), UCase("Issue")) > 0 Then
             Issue = Trim(Split(mybody(compt), ":")(1))
             Issue = Split(Issue, "Benchmark")
             Issue = Trim(Issue(0))
             Issue_passage = Issue_passage + 1
         End If
         End If

 'coupon courru
 If coupon_passage <> 1 Then
   If InStr(1, UCase(mybody(compt)), UCase("Acc Int")) > 0 Then
               Coupon_couru = Trim(Split(mybody(compt), ":")(1))
               Coupon_couru = Split(Coupon_couru, , 7)
               Coupon_couru = Coupon_couru(0)
coupon_passage = coupon_passage + 1
End If
End If

If Settle_date <> 1 Then
   If InStr(1, UCase(mybody(compt)), UCase("Settle Date")) > 0 Then
               Settle_date = Trim(Split(mybody(compt), ":")(2))
         Settle_date_passage = Settle_date_passage + 1
End If
End If

'sens de lopération
If Sens_passage <> 1 Then
   If InStr(1, UCase(mybody(compt)), UCase(" Buy/Sell")) > 0 Then
               Sens = Trim(Split(mybody(compt), ":")(1))
               Sens = Split(Sens, "Quantity")
             Sens = Trim(Sens(0))
           Sens_passage = Sens_passage + 1
           If Sens = "B" Then

           Sens = "A"

           Else

           Sens = "V"

End If

End If
End If

        Next
Sheets("extraction").Activate
        Cells(b, 1) = Sens
        Cells(b, 2) = ISIN
        Cells(b, 3) = Qte
        Cells(b, 4) = Issue
        Cells(b, 5) = montant
        Cells(b, 6) = Price
        Cells(b, 7) = trade_date
        Cells(b, 8) = TRI
        Cells(b, 9) = Settle_date
        Cells(b, 10) = Coupon_couru

     b = b + 1
  End If
End If
Next i

End Sub

Ma question est, est-il possible une fois les données récupérés, que mon code VBA affiche le mail étant comme "Lu" ?

Une autre interrogation, je récupère des fois ces données pas dans le corps des mails mais en piece jointe via un pdf, est-il possible de récupérer ces données également? si oui, auriez vous des topiques à me suggérer ?

Merci de votre aide,

Bonne soirée,

Le 06/02/2022 à 17:13

bonjour,

pour indiquer que le mail a été lu, essaie ceci (non testé)

If i.UnRead And fromsender(1) = "bloomberg.net" Then
        sujet = i.Subject
        i.UnRead = False 'indiquer que le mail a été lu
        mybody = Split(i.Body, vbCrLf)
Le 07/02/2022 à 18:58

Bonjour h2so4,

Merci pour ta réponse ça marche niquel, du coup j'effectuais ma macro sur un classeur "brouillon" avant de l'introduire dans mon vrai classeur Excel,

cependant ça bloque maintenant au moment de la déclaration olAPP:

image

alors que sur l'autre classeur cela fonctionnait parfaitement quelqu'un aurait une piste ?

Merci de votre aide,

Le 07/02/2022 à 19:07

bonsoir,

tu as probablement une référence à la librairie Outlook qui manque en VBA (VBE, menu outil, références sélectionner ms outlook)

Le 18/02/2022 à 09:44

Bonjour,

Désolé de ma réponse tardive j'étais en vacances !

Parfait ça marche nickel, j'ai enrichie ma macro ce qui donne le résultat suivant:

Public Issue As Variant
Public Qte As Variant
Public Price As Variant
Public Entité As String

Sub LireMessages()
Dim olapp As Outlook.Application
Set olapp = New Outlook.Application
Dim NS As Object, Dossier As Object
Dim OlExp As Object
Dim i As Object
Dim mybody() As String
Dim fromsender() As String
Dim prelevement As Date
Dim montant As Variant
'Dim traitement As Integer
'Workbook
ThisWorkbook.Activate
'Worksheets("Extraction").Activate
Nbligne = Range("C65536").End(xlUp).Row

Set NS = olapp.GetNamespace("MAPI")
Set Dossier = NS.GetDefaultFolder(olFolderInbox).Folders("VCON BLOOM")
b = Nbligne + 1

For Each i In Dossier.Items
fromsender = Split(i.SenderEmailAddress, "@")
If i.SenderEmailType <> "EX" Then
sujet = i.Subject
'blntmsgusr@bloomberg.net
    If i.UnRead And fromsender(1) = "bloomberg.net" Then
        sujet = i.Subject
        mybody = Split(i.Body, vbCrLf)
        i.UnRead = False

     'REINITIALISATION DES VARIABLES PASSAGE

   Tri_passage = 0
    prix_passage = 0
    montant_passage = 0
     qte_passage = 0
      montant_passage = 0
      Isin_passage = 0
      Issue_passage = 0
      Settle_date_passage = 0
      Sens_passage = 0
      coupon_passage = 0
      broker_passage = 0
      VN_passage = 0

    '    dejafait = True
       ' dejafait2 = True
        For compt = 0 To UBound(mybody)

        'TRA
            If Tri_passage <> 1 Then
            If InStr(1, UCase(mybody(compt)), UCase("Yield")) > 0 Then
                TRI = Trim(Split(mybody(compt), ":")(2))
                Tri_passage = Tri_passage + 1
            End If
            End If

            'trade_date probleme format ricain (1er passage)
            If InStr(1, UCase(mybody(compt)), UCase("Trade Date")) > 0 = True Then
                trade_date = Trim(Split(mybody(compt), ":")(2))
               ' trade_date = Format(WorksheetFunction.WorkDay(trade_date, 3), "dd/mm/yyyy")
                dejafait = False
            End If

            'prix_oblig (1er passage)
            If prix_passage <> 1 Then
            If InStr(1, UCase(mybody(compt)), UCase("Price")) > 0 Then
               Price = Trim(Split(mybody(compt), ":")(1))
               Price = Split(Price, "Yield")
               Price = Trim(Price(0))
               prix_passage = prix_passage + 1
            End If
            End If

            'Net probleme de format de nombre (1er passage)
            If montant_passage <> 1 Then
            If InStr(1, UCase(mybody(compt)), UCase("Net")) > 0 Then
                montant = Trim(Split(mybody(compt), ":")(1))
                montant = Split(montant, " ", 2)
                montant_passage = montant_passage + 1
         '       montant = Format(montant, "##,##0.00")
            montant = montant(0)
             '   MsgBox (montant(0))
            '    dejafait2 = False
            End If
            End If
     'valeur_nominal (1er passage)
     If qte_passage <> 1 Then
            If InStr(1, UCase(mybody(compt)), UCase("Quantity")) > 0 Then
           Qte = Trim(Split(mybody(compt), ":")(2))
           qte_passage = qte_passage + 1
            End If
            End If

            'ISIN
            If Isin_passage <> 1 Then
              If InStr(1, UCase(mybody(compt)), UCase("ISIN")) > 0 Then
             ISIN = Trim(Split(mybody(compt), ":")(1))
             Isin_passage = Isin_passage + 1
         End If
         End If

          'Issue
            If Issue_passage <> 1 Then
              If InStr(1, UCase(mybody(compt)), UCase("Issue")) > 0 Then
             Issue = Trim(Split(mybody(compt), ":")(1))
             Issue = Split(Issue, "Benchmark")
             Issue = Trim(Issue(0))
             Issue_passage = Issue_passage + 1
         End If
         End If

   'broker

              If broker_passage <> 2 Then
              If InStr(1, UCase(mybody(compt)), UCase("Broker")) > 0 Then
             broker = Trim(Split(mybody(compt), ":")(1))
             broker_passage = Issue_passage + 1

             If broker = "CIC INFORMATION" Then

             broker = "CIO"

            End If

              If broker = "Natixis Govt Autoex" Then

             broker = "NATIXIS"

            End If

              If broker = "GFI SECURITIES LTD" Then

             broker = "GFI"

            End If

         End If

               If broker = "mizuho" Then

             broker = "MIZUHO"

            End If

                If broker = "JPM CHASE EURO JPGV" Then

             broker = "JP Morgan"

            End If

                If broker = "SOCIETE GEN - DEFI" Then

             broker = "SOCIETE GENERALE"

            End If

         End If

 'coupon courru
 If coupon_passage <> 1 Then
   If InStr(1, UCase(mybody(compt)), UCase("Acc Int")) > 0 Then
               Coupon_couru = Trim(Split(mybody(compt), ":")(1))
               Coupon_couru = Split(Coupon_couru, , 7)
               Coupon_couru = Coupon_couru(0)
coupon_passage = coupon_passage + 1
End If
End If

 If VN_passage <> 1 Then
   If InStr(1, UCase(mybody(compt)), UCase("Acc Int")) > 0 Then
               Coupon_couru = Trim(Split(mybody(compt), ":")(1))
               Coupon_couru = Split(Coupon_couru, , 7)
               Coupon_couru = Coupon_couru(0)
VN_passage = coupon_passage + 1
End If
End If

If Settle_date <> 1 Then
   If InStr(1, UCase(mybody(compt)), UCase("Settle Date")) > 0 Then
               Settle_date = Trim(Split(mybody(compt), ":")(2))
         Settle_date_passage = Settle_date_passage + 1
End If
End If

'sens de lopération
If Sens_passage <> 1 Then
   If InStr(1, UCase(mybody(compt)), UCase(" Buy/Sell")) > 0 Then
               Sens = Trim(Split(mybody(compt), ":")(1))
               Sens = Split(Sens, "Quantity")
             Sens = Trim(Sens(0))
           Sens_passage = Sens_passage + 1
           If Sens = "B" Then

           Sens = "A"

           Else

           Sens = "V"

End If
End If

'If broker = "CIC INFORMATION" Then broker = "CIC OUEST"
'broker = "CIC OUEST"
'End If

End If

        Next

User.Show

Sheets(Entité & " 2022").Activate

b = Sheets(Entité & " 2022").Range("A2").End(xlDown).Row

ref = Sheets(Entité & " 2022").Range("A" & b).Value

     Cells(b + 1, 1) = ref + 1
     Cells(b + 1, 2) = trade_date
     Cells(b + 1, 3) = "OBLIGATIONS"
     Cells(b + 1, 4) = Sens
     Cells(b + 1, 5) = Qte
     Cells(b + 1, 6) = broker
     Cells(b + 1, 7) = ISIN
     Cells(b + 1, 8) = Issue
     Cells(b + 1, 10) = TRI
     Cells(b + 1, 10) = Cells(b + 1, 10) * 0.01
     Cells(b + 1, 11) = Price
     Cells(b + 1, 14) = montant
'     Cells(b + 1, 12) = (Price * Qte) / 100
   '  Cells(b + 1, 14) = (Price * Qte) / 100 + Coupon_couru
     Cells(b + 1, 25) = Settle_date

      b = b + 1

'        Cells(b, 1) = Sens
'        Cells(b, 2) = ISIN
'        Cells(b, 3) = Qte
'        Cells(b, 4) = Issue
'        Cells(b, 5) = montant
'        Cells(b, 6) = Price
'        Cells(b, 7) = trade_date
'        Cells(b, 8) = TRI
'        Cells(b, 9) = Settle_date
'        Cells(b, 10) = Coupon_couru
'        Cells(b, 11) = broker
'

  End If
End If
Next i

End Sub

avec mon userform que j'ai crée, pour pouvoir attribuer ces informations sur une autre page si besoin:

Private Sub CommandButton1_Click()

If OptionButton1 = True Then
Entité = "TA"
End If
If OptionButton2 = True Then
Entité = "TP"
End If
Unload Me
UserForm1.Hide

End Sub

Private Sub CommandButton2_Click()
Unload Me
End Sub

Private Sub OptionButton1_Click()

End Sub

Private Sub OptionButton2_Click()
If OptionButton2 = True Then
Entité = "TP"
End If

End Sub

Private Sub TextBox1_Change()

End Sub

Private Sub TextBox2_Change()

End Sub

Private Sub TextBox3_Change()

End Sub

Public Sub UserForm_Activate()

End Sub

Private Sub UserForm_Click()

End Sub

Private Sub UserForm_Initialize()
OptionButton1 = True
TextBox1 = Issue
TextBox2 = Qte
TextBox3 = Price
TextBox1.Locked = True
TextBox2.Locked = True
TextBox3.Locked = True

End Sub

et mon problème c'est que maintenant il m'affiche constamment:

image

ça ne bloque pas ma macro, mais c'est un peu pénible et j'ai l'impression c'est depuis que j'ai mit mes variables en publique que cela me fait ça.

J'ai utilisé cette méthode pour pouvoir faire en sorte que les variables de mon userform et de ma macro puisse "communiquer" mais je sais pas si c'est la bonne méthode à appliquer.

Merci de votre aide,

Bonne journée !

Rechercher des sujets similaires à "mettre mail comme outlook"