XL 2016 vba- récupérer / extraire infos sur corps du mail ouvert outlook

[andrekn13]

Bonjour
Je reviens sur ce forum ! comme le velo, c'est un reflexe
J'ai vu beaucoup de posts concernant le moyen de faire une boucle sur tous les mails afin de recuperer le body etc.
Je tourne en rond et m'épuise car je ne cherche qu'à extraire uniquement sur le mail ouvert : ( toujours la même présentation )
en rouge : texte de référence
en vert : texte à extraire
DI n° : 123456 ( 6 numéros) = Range("A1")
Site : xxxxxxxxxxxxxx xxxxx xxx (variable) =Range("A2")
Contrat n° : CS377477 = Range("A3")
l'expéditeur = Range("A4")
le nom = Range("A5") malheuresement pas de point de ref , il y a avant 2 lignes vides et la 3ème avant commence par NB :
je n'ai toujours pas compris comment le body est structuré afin d'en extraire les données
Voilà , si un petit coup de pouce sur ce site de mordus de vba ( et bien plus ! ) me serait trop utile.
Félicitation à tous

 

[zebanx]

Bonjour andrekn13, le forum

Comment extraire les données de l'expéditeur et du nom s'ils n'y a pas de "balises", ce que vous avez identifié en "rouge" ?
Si la structuration du body ne le permet pas, cela va être forcément compliqué car toute extraction potentielle repose, à ma connaissance, sur l'existence de ces dernières.
Je vous invite à faire peut-être un copier coller de l'image du mail pour permettre d'y voir plus clair (votre description est bonne mais une image permet de voir aussi).

Bon développement
zebanx

 

[andrekn13]

 

[andrekn13]

quand j'utilise l'enregistreur de macro pour identifier la struture , c'est inexploitable, c'est un paste spécial HTLM . J'ai pensé à copier tout le corps du body sur une feuille temporaire.
J'ai pas réussi à adapter ce code interressant où il récupère le corps du body, extrait avec balise :
Sub LireBodyEmail()
Dim I As Long, Ligne As Long
Dim strTemp As String
Dim objOL As Object
Dim MyNameSpace As Object
Dim MyFolder As Object
Dim Courriel As Object
Dim Pos As Long
Dim Num

On Error GoTo Erreur

Set objOL = CreateObject("Outlook.Application")
Set MyNameSpace = objOL.GetNamespace("MAPI")

'Déterminer le chemin du dossier à lire
Set MyFolder = MyNameSpace.Folders.Item(1).Folders("Boîte de réception").Folders("Mon Dossier")


For Each Courriel In MyFolder.Items
Ligne = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1 'nouvelle ligne du classeur
strTemp = Courriel.Body 'place le corps du message dans un chaîne

'Recherche du terme "numéro de commande:"
Pos = InStr(1, LCase(strTemp), "numéro de commande:") 'position du "n" de numéro
If Pos > 0 Then
For I = Pos + 20 To Pos + 40 'on boucle 20 caractères à partir de la fin de "numéro de commande:"
If Mid(strTemp, I, 1) <> " " And Not IsNumeric(Mid(strTemp, I, 1)) Then
Range("A" & Ligne) = Val(Num)
Exit For
Else
Num = Num & Mid(strTemp, I, 1)
End If
Next
End If

'Recherche du terme "numéro de livraison:"
Num = ""
Pos = InStr(1, LCase(strTemp), "numéro de livraison:")
If Pos > 0 Then
For I = Pos + 20 To Pos + 40
If Mid(strTemp, I, 1) <> " " And Not IsNumeric(Mid(strTemp, I, 1)) Then
Range("B" & Ligne) = Val(Num)
Exit For
Else
Num = Num & Mid(strTemp, I, 1)
End If
Next
End If
Next

MsgBox "Terminé"

Set objOL = Nothing
Set MyNameSpace = Nothing
Set MyFolder = Nothing

Exit Sub
Erreur:
MsgBox Err.Number & vbCrLf & Err.Description
End Sub

 

[andrekn13]

Re bonjour à tous
Je n'arrive pas à comprendre ce message d'erreur quand je ne change juste le dossier concerné pour déjà faire un test rapide :

 

[zebanx]

Re-

Je vous répondrai en fin d'apm en plus de ceux qui se saisiraient du sujet.
Mais la structuration très spécifique de votre "message" type conduira vraisemblablement à des erreurs du fait de la gestion non balisée pour les deux derniers champs.

Xl-ment

 

[andrekn13]

je buche depuis ce matin, déjà en VBA excel, c'est corsé, mais ajouter outlook je me suis dispersé , essayé 50 codes . Lol J'avais l'utopie de même créer un lien hypertexte sur ma facture qui me renvoie directement au bon de commande . Même là j'arrive toujours pas à créer un bouton macro dans outlook.... ( https://forum.excel-pratique.com/excel/comment-importer-un-message-outlook-dans-excel-105141) J'en pleur de rage que je tourne en rond. trop complexe pour moi
Je te remercie déjà beaucoup. Se sentir épauler ça donne courage pour perséverer

 

[zebanx]

Ce n'est pas la peine de se dire que c'est simple puisque ce ne l'est pas.
J'y arrive après de très longues recherches aussi et parce que j'en avais besoin.
Mais sans balises, c'est encore plus compliqué (élémentaire mon cher Holmes!)

Mais on arrive à extraire quelques informations quand même.
Je vous enverrai un message vers 18 heures normalement (pour ma part, d'autres peuvent répondre avant).

 

[andrekn13]

Re
en attendant j'ai pu réussir à importer les données extérieures ( sauf le lien direct du mail concerné )
voici capture :

voici code :
Sub InsertionMoi()

Dim OpenOutlk As Object, NS As Object, Inbox As Object
Dim DossierDest As Object ', DossierCible As Object
Dim sDate As String
Dim sText As String
Dim tempo As String
Dim Tableau() As String
Dim mybody() As String
Dim i As Object, x As Long, R As Object
Dim j As Long
Dim t As Long
Dim l As Long

Dim StartAlert As Long
Dim EndAlert As Long
Dim Alert As String
Dim StartAlerteTrouve As Long
Dim EndAlerteTrouve As Long

Set OpenOutlk = CreateObject("Outlook.Application")
Set NS = OpenOutlk.GetNamespace("MAPI")
Set Inbox = NS.GetDefaultFolder(olFolderInbox)

Set DossierSource = Inbox.Folders("a remplir")
' Set DossierDest = Inbox.Folders("à remplir")

'''''traitement des mails du dossier DossierSource

j = 1

For Each i In DossierSource.Items

j = j + 1

'''''Date de réception du mail
sDate = Format(i.SentOn, "MM/dd/yyyy")
ThisWorkbook.Worksheets("mail").Cells(j, 1) = sDate

'''''Nom de l'expéditeur
ThisWorkbook.Worksheets("mail").Cells(j, 2) = i.SenderName

'''''Mail de l'expéditeur

'ThisWorkbook.Worksheets("MailNoe").Cells(j, 3) = i.SenderEmailAddress
tempo = i.SenderEmailAddress
ThisWorkbook.Worksheets("mail").Cells(j, 3).Hyperlinks.Add Anchor:=Cells(j, 3), Address:="mailto:" & tempo, TextToDisplay:=tempo

'''''Objet du mail
ThisWorkbook.Worksheets("mail").Cells(j, 4) = i.Subject




'''''''''''''''''''''En développement
sText = i.Body
Tableau = Split(sText, " ")
MsgBox sText
Range("E2") = sText
''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''Fin partie en Développement

StartAlerteTrouve = 0
EndAlerteTrouve = 0
'i.Move DossierDest
Next i
'''''''''''''''''''''''''
Set NS = Nothing
Set OpenOutlk = Nothing

End Sub
EFFECTIVEMENT, je comprends mieux , tout est dans une ceule cellule et galère de créer recherche sur balises

 

[zebanx]

Re-

Deux extractions dans le fichier ci-joint:
1/ Avec le fichier ouvert, comme demandé au #1.
Il importe que le fichier soit réellement ouvert.
2/ Avec une boucle sur le répertoire que l'on choisi (par défaut, la boite de réception).
Pas besoin d'avoir un seul fichier ouvert.

Le paramétrage d'ensemble est fastidieux à détailler en ligne à ligne.
Et certains paramètres difficiles à expliquer.

En dégrossi :
- Messageline : permet de prendre la ligne après un séparateur (":")
- Messagearray() : permet de prendre la ligne suivante (retour à la ligne)

Pour complément :
- Il importe que les balises soient différentes pour ne pas créer de doublons (ici il y a 3 caractères pour chaque "case" mais si on avait plusieurs "date :", il faudrait revoir le fichier source qui sert à rapatrier les informations. Mais ce n'est pas le cas ici.
- J'ai réussi, en tâtonnant, à extraire le nom du demandeur mais je ne garantie rien sur les différents fichiers à contrôler.
Vous avez bien compris que cela dépendait du nombre de saut de ligne dans le body puisque les champs "nom de la société" et "nom du demandeur" ne sont pas aussi faciles à extraire que les premiers champs. Quoique pour nom de la "société" on soit normalement une ligne en dessous de "cordialement,"

Bonne trituration
zebanx

 

[andrekn13]

Bonjour Zebanx !
J'ai travaillé ton code depuis 19h car je devais formater chaque réponse dans des cellules précises dans ma facture. Lol même ça il faut bucher !
Bref.... en comprenant ton code ( pas toutes subtilités évidemment) j'ai trouvé l'astuce pour baliser le " chargé d'affaire" :

Select Case Right(msgLine(0), 6)
Case "faires" ' (6 dernières lettres de : Chef de groupe Maintenance - Chargée d'Affaires)
On Error Resume Next
anchor.Offset(i, 1).Value = messageArray(j - 1) '( je remonte à la ligne avant)
On Error GoTo 0
End Select
Je pensais vraiment pas y arriver mais vu le boulot que tu fournis , tu m'as donné ce courrage !!!!
merci beaucoup !!!!!

Je vais voir si je peux recupérer " le lien hypertexe du mail . car il y a le pdf avec contrat complet et détails. Ras le bol de "fouiller" pour retrouver le bon.

mes compliments les plus sincères

 

[andrekn13]

Bon....... encore un SOS

J'avais travaillé juste sur cette macro en insérant une facture type pour avoir ma macro nickel.
J'insère donc le module "propre" dans mon xlm final et là .............. Erreur !!!!!!
C'est un fichier avec 25 modules et env 80 macros au pif
J'ai pleins de macros qui ouvrent Outlook , donc avec des variables , des noms différents .
Comme ça à toujours marché ...... jusqu'à présent !
je bugg royal , c'est pourtant la toute première déclaration

 

[andrekn13]

exemple de macro que j'ai

 

[andrekn13]

décidément ..........
Au tout début, j'avais bien ajouté en vbap , préférences, le Microsoft Outlook 16.0 object librairy sur mon fichier d'essai
hors en ouvrant mon fichier original, finalement c'est pas pris en compte. Lol
Est-ce au fichier ??
j'étais certain que ce sont dans les parametres de Excel lui-même , non ?
Bon..... en c'est résolu et ça marche nickel !!!!