Я новичок в vba и пытаюсь решить мою ситуацию, когда мы получаем несколько писем, как показано ниже:
мы хотели бы создать базу данных в excel для всех писем, которые находятся в моей конкретной папке
Краткое описание пакета:
Клиент: XYZ
Цена (в долларах США): 3000
Время: 1 неделя
Идентификатор проекта:21312
и еще немного текста ......
здесь мы хотели бы получить информацию о клиенте, цене (долларах США), времени, идентификаторе проекта.
Попробовал приведенный ниже код, который собирает информацию и сохраняет ее в файле Excel.
Sub GetFromOutlook()
Dim OutlookApp As Outlook.Application
Dim OutlookNamespace As Namespace
Dim Folder As MAPIFolder
Dim OutlookMail As Variant
'Dim i As Integer
Set OutlookApp = New Outlook.Application
Set OutlookNamespace = OutlookApp.GetNamespace("MAPI")
Set Folder = OutlookNamespace.GetDefaultFolder(olFolderInbox).Folders("Dummy").Folders("New Dummy")
'i = 1
For Each OutlookMail In Folder.Items
Dim sText As String
sText = OutlookMail.Body
Dim Reg1 As RegExp
Dim M1 As MatchCollection
Dim M As Match
Dim vText, vText2, vText3, vText4 As Variant
Dim i As Integer
Set Reg1 = New RegExp
' \s* = invisible spaces
' \d* = match digits
' \w* = match alphanumeric
For i = 1 To 9
With Reg1
Select Case i
Case 1
.Pattern = "(Client[:]([\w-\s]*)\s*)\n"
.Global = False
Case 2
.Pattern = "(([\d]*\,[\d]*))\s*\n"
.Global = False
Case 3
.Pattern = "(Time[:]([\w-\s]*)\s*)\n"
.Global = False
Case 4
.Pattern = "(Project Id[:]([\w-\s]*)\s*)\n"
.Global = False
End Select
End With
If Reg1.Test(sText) Then
Set M1 = Reg1.Execute(sText)
Select Case i
Case 1
For Each M In M1
vText = Trim(M.SubMatches(1))
Next
Case 2
For Each M In M1
vText2 = Trim(M.SubMatches(1))
Next
Case 3
For Each M In M1
vText3 = Trim(M.SubMatches(1))
Next
Case 4
For Each M In M1
vText4 = Trim(M.SubMatches(1))
Next
End Select
End If
Next i
Range("a1000").End(xlUp).Offset(1, 0).Value = vText
Range("b1000").End(xlUp).Offset(1, 0).Value = vText2
Range("c1000").End(xlUp).Offset(1, 0).Value = vText3
Range("d1000").End(xlUp).Offset(1, 0).Value = vText4
Next OutlookMail
Set Folder = Nothing
Set OutlookNamespace = Nothing
Set OutlookApp = Nothing
End Sub
Задачи:
Задача 1: еслизаголовок Price (USD) изменяется на Price (GBP), сохраняя при этом значение, которое не должно быть.он должен хранить значение только в том случае, если найден соответствующий текст.
я попробовал "(Цена (USD) [:] ([\ d] \, [\ d] )) \s * \ n ", однако это не работает.
Задача 2: для идентификатора проекта, значение также идет с подчеркиванием, которое я не могу исключить.
Будеточень признателен, если кто-то может помочь мне решить вышеупомянутую проблему из моего кода.
или предложить какой-то лучший подход к тому же.