Ваш вопрос слишком расплывчат для конкретного ответа. Все, что я могу предложить, это руководство по первым этапам.
Вам необходимо решить, что является фиксированным, а что переменным.
Исправлено ли «@ ABC4»? «@ ABC4: пожалуйста, добавьте в систему следующую информацию (для»)?
Всегда ли есть две строки данных? Есть ли несколько строк данных, примерами которых они являются? Является ли формат этих строк:
Xxxxxxx space hyphen hyphen hyphen space amount
Я бы начал с разделения текста на строки. Почти наверняка строки нарушены переводом каретки-возврата. Для проверки:
Dim Count As Long
For Each olMail In olItms
Debug.Print Replace(Replace(Mid$(olMailBody, 1, 200), vbCr, "{c}"), vbLf, "{l}" & vbLf)
Count = Count + 1
If Count >= 10 Then
Exit For
End If
Next olMail
Вывод будет выглядеть примерно как десять (максимум) копий:
@ABC4: please add the following detail in system (for 12-Jan-2019):{c}{l}
{c}{l}
12345_ABC_MakOpt --- 264532154.78{c}{l}
12345_ABC_GAPFee --- 145626547.80{c}{l}
Are the characters between lines “{c}{l}” or “{l}” or something else?
В приведенном ниже коде замените vbCR & vbLf, если необходимо, затем запустите его:
Dim Count As Long
Dim InxL As Long
Dim Lines() As String
For Each olMail In olItms
Lines = Split(olMail.Body, vbCR & vbLf)
For InxL = 0 to UBound(Lines)
Debug.Print InxL + 1 & " " & Lines(InxL)
Next
Count = Count + 1
If Count >= 10 Then
Exit For
End If
Next
Вывод будет выглядеть примерно как десять (максимум) копий:
0
1 @ABC4: please add the following detail in system (for 12-Jan-2019):
2
3 12345_ABC_MakOpt --- 264532154.78
4 12345_ABC_GAPFee --- 145626547.80
5
Теперь вы можете видеть текстовое тело в виде линий. Примечание: первая строка - номер 0. Вверху никогда не бывает пустой строки? Вверху всегда есть пустая строка? Это меняется? Я собираюсь предположить, что всегда есть пустая строка сверху. Следующий код нуждается в модификации, если это предположение неверно.
Если в строке 1 указано «xxxxxxxxxx date):», вы можете извлечь дату так:
Dim DateCrnt As Date
Dim Pos As Long
DateCrnt = CDate(Left$(Right$(Lines(1), 13), 11))
или
Pos = InStr(1, Lines(1), "(for ")
DateCrnt = CDate(Mid$(Lines(1), Pos + 5, 11))
Примечание: оба эти метода зависят от того, какой конец строки соответствует тому, что вы показываете в своем примере. Если есть какой-либо вариант, вам понадобится код, который обрабатывает этот вариант.
Теперь вы можете разбить строки данных с помощью кода, подобного следующему:
Dim NameCrnt As String
Dim AmtCrnt As Double
For InxL = 3 To UBound(Lines)
If Lines(InxL) <> "" Then
Pos = InStr(1, Lines(InxL), " --- ")
If Pos = 0 Then
Debug.Assert False ' Line not formatted as expected
Else
NameCrnt = Mid$(Lines(InxL), 1, Pos - 1)
AmtCrnt = Mid$(Lines(InxL), Pos + 5)
End If
Debug.Print "Date="& DateCrnt & " " & "Name=" & NameCrnt & " " & "Amount=" & AmtCrnt
End If
Next
Вывод:
Date=12/01/2019 Name=12345_ABC_MakOpt Amount=264532154.78
Date=12/01/2019 Name=12345_ABC_GAPFee Amount=145626547.8
Новый раздел, показывающий, как добавить данные из электронной почты на лист
Это вторая версия этого раздела, потому что ОП передумал насчет необходимого формата.
Код ниже был протестирован, но с поддельными электронными письмами, которые я создал, чтобы быть похожим на тот, что в вашем вопросе. Так что, возможно, потребуется некоторая отладка.
Я создал новую рабочую книгу и новую рабочую таблицу под названием «Исправления» со следующими заголовками:
После обработки моих поддельных электронных писем лист выглядел следующим образом:
Последовательность строк зависит от последовательности, в которой были найдены электронные письма. Вы, вероятно, хотите сначала новые. Сортировка листа выходит за рамки этого ответа. Примечание: именно заголовки столбцов сообщают макросу, какие значения должны быть записаны. Если в электронное письмо была добавлена новая строка, добавьте новый заголовок столбца, и значение будет сохранено без изменения макроса.
За одним исключением, я не буду объяснять операторы VBA, которые я использовал, потому что легко найти в Интернете «VBA xxxxx» и найти спецификацию для оператора xxxxx. Исключением является использование двух коллекций для хранения ожидающих данных. Остальные объяснения описывают причины моего подхода.
В требования будут внесены изменения, хотя, возможно, не в течение шести или двенадцати месяцев. Например, менеджер будет хотеть другой заголовок или столбцы в другой последовательности. Вы не можете предвидеть, какие изменения потребуются, но вы можете подготовиться к изменениям. Например, в верхней части моего кода у меня есть:
Const ColFixDate As Long = 1
Const ColFixDataFirst As Long = 2
Const RowFixHead As Long = 1
Const RowFixDataFirst As Long = 2
Я мог бы написать Cells(Row, 1).Value = Date. Это имеет два недостатка: (1) если столбец даты когда-либо перемещается, вы должны искать в коде операторы, которые обращаются к нему, и (2) вы должны помнить, что находится в столбце 1, 2 или 3, делая ваш код труднее читать. Я избегаю использования литералов для номеров строк или столбцов. Дополнительные усилия по вводу ColFixDataFirst вместо 2 быстро окупаются.
Я заметил, что в коде, добавленном к вашему вопросу, вы используете именованные диапазоны для достижения того же эффекта. Проблема с VBA состоит в том, что часто есть несколько способов достижения того же самого эффекта. Я предпочитаю постоянные, но каждый из нас должен выбирать свои собственные фавориты.
ПоработавВ отделе, который обрабатывал много электронных писем и рабочих книг, полученных от посторонних, которые содержали полезные данные, я могу вам сказать, что их форматы постоянно меняются. Там будет лишняя пустая строка или будет удалена существующая. Там будут дополнительные данные или существующие данные будут в другой последовательности. Авторы вносят изменения, которые, по их мнению, будут полезны, но редко делают что-то полезное, например, спрашивают, хотят ли получатели изменения или даже предупреждают их об этом. Худшее, что я когда-либо видел, было, когда два числовых столбца были перепутаны, и это не было замечено в течение многих месяцев К счастью, я не был вовлечен, потому что это был страшный сон, когда мы возвращали ошибочные данные из нашей системы и затем импортировали правильные данные. Я проверяю все, что могу придумать, и отказываюсь обрабатывать электронные письма, которые не соответствуют моим ожиданиям. Все сообщения об ошибках записываются в непосредственное окно, которое удобно во время разработки. Вы можете использовать MsgBox или записать их в файл. Если письмо успешно обработано, оно не удаляется; он перемещается в подпапку, поэтому его можно извлечь, если он когда-либо понадобится снова.
olMail является константой Outlook. Не используйте olMail или любое другое зарезервированное слово в качестве имени переменной.
Я использовал Session вместо NameSpace. Предполагается, что они эквивалентны, но однажды у меня была проблема с пространством имен, которую я не смог диагностировать, поэтому я больше не использую их.
Я не сортирую письма, так как ваш код не использует сортировку писем. Возможно, вы могли бы воспользоваться сортировкой по ReceivedTime, но я вижу потенциальные проблемы, которых будет нелегко избежать.
Я обрабатываю электронные письма в обратном порядке, потому что они доступны по позиции. Например, если электронная почта 5 перемещена в другую папку, предыдущая электронная почта 6 теперь является электронной почтой 5, и цикл For пропускает ее. Если электронные письма обрабатываются в обратном порядке, вы не возражаете, что электронная почта 6 теперь является электронной почтой 5, потому что вы уже обработали эту электронную почту.
Если вы не установите NumberFormat ячеек, содержащих даты или суммы, они будут отображаться в соответствии с настройками Microsoft по умолчанию для вашей страны. Я использовал мои любимые форматы отображения. Поменяй на любимую.
Код ничего не выводит на лист до тех пор, пока не будет обработана вся электронная почта и не извлечены необходимые данные. Это означает, что данные из ранних строк данных должны храниться до тех пор, пока не будут обработаны все строки. Я использовал два Collections: PendingNames и PendingAmts. Я бы не стал хранить данные в макросе, который написал для себя. Моя проблема в том, что альтернативные подходы являются более сложными или требуют более продвинутых VBA.
Вернись с вопросами о чем-то еще, что ты не понимаешь.
Option Explicit
Sub GetFromInbox()
Const ColFixDate As Long = 1
Const ColFixName As Long = 2
Const ColFixAmt As Long = 3
Const RowFixDataFirst As Long = 2
Dim AmtCrnt As Double
Dim ColFixCrnt As Long
Dim DateCrnt As Date
Dim ErrorOnEmail As Boolean
Dim Found As Boolean
Dim InxItem As Long
Dim InxLine As Long
Dim InxPend As Long
Dim Lines() As String
Dim NameCrnt As String
Dim olApp As New Outlook.Application
Dim olFldrIn As Outlook.Folder
Dim olFldrOut As Outlook.Folder
Dim olMailCrnt As Outlook.MailItem
Dim PendingAmts As Collection
Dim PendingNames As Collection
Dim Pos As Long
Dim RowFixCrnt As Long
Dim StateEmail As Long
Dim TempStg As String
Dim WshtFix As Worksheet
Set WshtFix = ThisWorkbook.Worksheets("Fixings")
With WshtFix
RowFixCrnt = .Cells(Rows.Count, ColFixDate).End(xlUp).Row + 1
End With
Set olApp = New Outlook.Application
Set olFldrIn = olApp.Session.GetDefaultFolder(olFolderInbox).Folders("impMail")
Set olFldrOut = olFldrIn.Folders("Processed")
For InxItem = olFldrIn.Items.Count To 1 Step -1
If olFldrIn.Items(InxItem).Class = Outlook.olMail Then
Set olMailCrnt = olFldrIn.Items(InxItem)
If InStr(olMailCrnt.Subject, "SubjectoftheEmail") > 0 Then
Lines = Split(olMailCrnt.Body, vbCr & vbLf)
'For InxLine = 0 To UBound(Lines)
' Debug.Print InxLine + 1 & " " & Lines(InxLine)
'Next
StateEmail = 0 ' Before "please add ..." line
ErrorOnEmail = False
Set PendingAmts = Nothing
Set PendingNames = Nothing
Set PendingAmts = New Collection
Set PendingNames = New Collection
For InxLine = 0 To UBound(Lines)
NameCrnt = "" ' Line is not a data line
Lines(InxLine) = Trim(Lines(InxLine)) ' Remove any leading or trailing spaces
' Extract data from line
If Lines(InxLine) <> "" Then
If StateEmail = 0 Then
If InStr(1, Lines(InxLine), "please add the ") = 0 Then
Debug.Print "Error with email received " & olMailCrnt.ReceivedTime & vbLf & _
" The first non-blank line is" & vbLf & _
" " & Lines(InxLine) & vbLf & _
" but I was expecting something like:" & vbLf & _
" @ABC4: please add the following detail in system (for 13-Jan-2019):"
ErrorOnEmail = True
Exit For
End If
TempStg = Left$(Right$(Lines(InxLine), 13), 11)
If Not IsDate(TempStg) Then
Debug.Print "Error with email received " & olMailCrnt.ReceivedTime & vbLf & _
" The value I extracted from the ""please add the ...""" & _
" line is """ & vbLf & " " & TempStg & _
""" which I do not recognise as a date"
ErrorOnEmail = True
Exit For
End If
DateCrnt = CDate(TempStg)
StateEmail = 1 ' After "please add ..." line
ElseIf StateEmail = 1 Then
If Lines(InxLine) = "" Then
' Ignore blank line
ElseIf Lines(InxLine) = "thanks" Then
' No more data lines
Exit For
Else
Pos = InStr(1, Lines(InxLine), " --- ")
If Pos = 0 Then
Debug.Print "Error with email received " & olMailCrnt.ReceivedTime & vbLf & _
" Data line: " & Lines(InxLine) & vbLf & _
" does not contain ""---"" as required"
ErrorOnEmail = True
'Debug.Assert False
Exit For
End If
NameCrnt = Mid$(Lines(InxLine), 1, Pos - 1)
TempStg = Mid$(Lines(InxLine), Pos + 5)
If Not IsNumeric(TempStg) Then
Debug.Print "Error with email received " & olMailCrnt.ReceivedTime & vbLf & _
" Data line:" & Lines(InxLine) & vbLf & _
" value after ""---"" is not an amount"
ErrorOnEmail = True
'Debug.Assert False
Exit For
End If
AmtCrnt = CDbl(TempStg)
End If
End If ' StateEmail
End If ' Lines(InxLine) <> ""
If ErrorOnEmail Then
' Ignore any remaining lines
Exit For
End If
If NameCrnt <> "" Then
' Line was a data line without errors. Save until know entire email is error free
PendingNames.Add NameCrnt
PendingAmts.Add AmtCrnt
End If
Next InxLine
If Not ErrorOnEmail Then
' Output pending rows now know entire email is error-free
With WshtFix
For InxPend = 1 To PendingNames.Count
With .Cells(RowFixCrnt, ColFixDate)
.Value = DateCrnt
.NumberFormat = "d mmm yy"
End With
.Cells(RowFixCrnt, ColFixName).Value = PendingNames(InxPend)
With .Cells(RowFixCrnt, ColFixAmt)
.Value = PendingAmts(InxPend)
.NumberFormat = "#,##0.00"
End With
RowFixCrnt = RowFixCrnt + 1
Next
End With
' Move fully processed email to folder Processed
olMailCrnt.Move olFldrOut
End If
End If ' InStr(olMailCrnt.Subject, "SubjectoftheEmail") > 0
End If ' olFldrIn.Items(InxItem).Class = Outlook.olMail
Next InxItem
Set olFldrIn = Nothing
Set olFldrOut = Nothing
olApp.Quit
Set olApp = Nothing
End Sub