Извлечь данные из электронной почты Outlook в Excel

У меня есть ~ 200 писем в день со следующим синтаксисом:

Hi, These are our clients. 548628797 FV THD EHSI 34215564824 JUAN CARLOS CORENDA ALVARES 1 31,43 243234133 FV THD EHSI 752520934982 JUAN CARLOS CORENDA ALVARES 2 2,8 2340291438 RFR WER IRJF 323442342312 CARLITO HIMAT 3,00 324 EHTF TGS HKTY 32423 WILLIAM TARING 1,2 Thank you! 
  1. Я извлекаю строки между «Это наши клиенты». и благодарю вас!" ? Некоторые электронные письма имеют только одну строку, а другие – 20 или более. Или лучше извлечь из строки 4 в конец-1?

  2. В excel, если я вставляю строки, имена будут разделены в разных ячейках. Я пытался:

     =IF(COUNT(FIND({0,1,2,3,4,5,6,7,8,9},J2))>0, K2&" "&L2&" "&M2&" "&N2, "NO NUMBERS IN J2") 

    Но как я могу остановить конкатенированное имя, пока оно не попадет в ячейку с суммой?

  3. Сумма, при вставленном в excel, будет игнорировать разделитель «,» и просто дает мне вместо 31,43 сумму 3143 и я должен вставить ее текст, чтобы иметь правильную сумму. Но если я вставляю текст, то вся строка будет вставлена ​​в одну ячейку не в разные ячейки.

У меня есть предыдущий код, который извлекает данные таблицы из электронных писем, но я не вижу, как реализовать код для моей текущей проблемы – в первую очередь, потому что я не знаю, как смотреть на извлечение. Извлеките тело в excel и замените первые 3 строки и последнюю строку на "" а затем разделите строки в столбцах или строках.

Макет линий от того, что я нашел до сих пор:

  • От 1 до 13 символов
  • 1 место
  • От 2 до 4 символов
  • если предыдущий имеет 2 символа, тогда 4 пробела /, если 3 char, затем 3 пробела /, если 4 char, затем 2 пробела
  • 4 char всегда
  • От 1 до 11 мест
  • От 1 до 15 символов
  • От 1 до 5 пробелов
  • имя с 7 именами (испанские имена) и может содержать номера в конце
  • От 1 до 20 мест
  • сумма может быть 1,00 или 1 и может быть 000000000001,15 (некоторая ошибка, которую они не могут исправить)

Текущий код:

 Sub exporttheirclients() Const FOLDER_PATH = "\\Mailbox - ME\Their clients" Dim olkMsg As Object, _ olkFld As Object, _ excApp As Object, _ excWkb As Object, _ excWks As Object, _ intRow As Integer, _ intCnt As Integer, _ data_email As String, _ strFilename As String, _ arrCells As Variant, _ varb As Variant, varD As Variant, varF As Variant Dim sinceDt, toDt As Date sinceDt = InputBox("STARTING PERIOD") toDt = InputBox("ENDING PERIOD") strFilename = "C:\THEIR CLIENTS\xlsx\TCLIENTS" If strFilename <> "" Then Set excApp = CreateObject("Excel.Application") Set excWkb = excApp.Workbooks.Add() Set excWks = excWkb.ActiveSheet excApp.DisplayAlerts = False With excWks .Cells(1, 1) = "SUBJECT" .Cells(1, 2) = "DATE" .Cells(1, 3) = "REF NR" .Cells(1, 4) = "AMOUNT" .Cells(1, 5) = "CITY" End With intRow = 2 Set olkFld = OpenOutlookFolder(FOLDER_PATH) For Each olkMsg In olkFld.Items data_email = olkMsg.ReceivedTime If olkMsg.Class = olMail Then If data_email >= sinceDt And data_email <= toDt + 1 Then arrCells = Split(GetCells(olkMsg.HTMLBody), Chr(255)) For intCnt = LBound(arrCells) To UBound(arrCells) Step 16 On Error GoTo Handler varb = arrCells(intCnt + 1) varD = arrCells(intCnt + 3) varF = arrCells(intCnt + 5) excWks.Cells(intRow, 1) = olkMsg.Subject excWks.Cells(intRow, 2) = Left(olkMsg.ReceivedTime, 10) excWks.Cells(intRow, 3) = varb excWks.Cells(intRow, 4) = varD excWks.Cells(intRow, 5) = Left(varF, 4) intRow = intRow + 1 Next End If End If Label1: Next Set olkMsg = Nothing excWkb.SaveAs strFilename, 52 excWkb.Close End If Set olkFld = Nothing Set excWks = Nothing Set excWkb = Nothing Set excApp = Nothing MsgBox "Ta dam! They have been exported ", vbInformation + vbOKOnly Call opexl Exit Sub Handler: Dim myOutlookFolders As Outlook.Folder Dim myDestFolder As Outlook.Folder Set myOutlookFolders = Session.GetDefaultFolder(olFolderInbox) Set myDestFolder = Session.Folders("Mailbox - ME").Folders("Their clients").Folders("Manually input") If olkMsg <> "Nothing" Then olkMsg.Move myDestFolder MsgBox "An email has been found with a problem. The search continues..." Else: End End If Resume Label1: End Sub 

Давайте будем гением компьютера.