我在电子邮件中有一个模式,我想在excel文件中提取。
序列号XXXX0XX 0000000
(4个字母,1个数字,2个字母,1个空格,7个数字,1个空格)
正则表达式:\ s *([0-9a-zA-Z] {7})\ s * \ w * \ s *
问题是它没有获得整个模式,只需要最后7位数。
Dim Reg1 As RegExp
Dim M1 As MatchCollection
Dim M As Match
Set Reg1 = New RegExp
With Reg1
.pattern = "The Serial Number+\s*([0-9a-zA-Z]){7}\s*\w*\s*"
.Global = True
End With
If Reg1.test(msg.Body) Then
Set M1 = Reg1.Execute(msg.Body)
For Each M In M1
Set rng = wks.Cells(i, j)
Dim strSubject As String
Debug.Print M.SubMatches(1)
strSubject = M.SubMatches(1)
rng.Value = strSubject
j = j + 1
Next
End If
其中rng.Value是来自excel的单元格。
以下是整个代码:
Sub SaveMessagesToExcel()
Dim appExcel As Excel.Application
Dim wkb As Excel.Workbook
Dim wks As Excel.Worksheet
Dim rng As Excel.Range
Dim strSheet As String
Dim i As Integer
Dim j As Integer
Dim lngCount As Long
Dim msg As Outlook.MailItem
Dim nms As Outlook.NameSpace
Dim fld As Outlook.MAPIFolder
Dim nColonCharIndex As Integer
Dim nBodyLength As Integer
Dim nNewLineCharIndex As Integer
Dim nOutputRow, nOutputColumn As Integer
Dim itm As Object
Dim strTitle As String
Dim strPrompt As String
strTemplatesPath = "C:\serials\"
strSheet = "not valid.xlsm"
strSheet = strTemplatesPath & strSheet
Debug.Print "Excel workbook: " & strSheet
If TestFileExists(strSheet) = False Then
strTitle = "Worksheet file not found"
strPrompt = strSheet & _
" not found; please copy Messages.xls to this folder and try again"
MsgBox strPrompt, vbCritical + vbOKOnly, strTitle
End If
Set appExcel = CreateObject("Excel.Application")
appExcel.Workbooks.Open (strSheet)
Set wkb = appExcel.ActiveWorkbook
Set wks = wkb.Sheets(1)
wks.Activate
wks.Range("A2:C300").Cells.Clear
Set nms = Application.GetNamespace("MAPI")
Const FOLDER_PATH = "\\Mailbox - me\Inbox\serial"
Set fld = OpenOutlookFolder(FOLDER_PATH)
If fld Is Nothing Then
End If
If fld.DefaultItemType <> olMailItem Then
MsgBox "Folder does not contain mail messages"
End If
lngCount = fld.Items.Count
If lngCount = 0 Then
MsgBox "No messages to export"
Else
Debug.Print lngCount & " messages to export"
End If
i = 3
For Each itm In fld.Items
If itm.Class = olMail Then
Set msg = itm
i = i + 1
j = 1
Set rng = wks.Cells(i, j)
If InStr(1, msg.Body, "is not valid") Then rng.Value = msg.Subject
j = j + 1
Set rng = wks.Cells(i, j)
If InStr(1, msg.Body, "is not valid") Then rng.Value = msg.ReceivedTime
j = j + 1
Dim Reg1 As RegExp
Dim M1 As MatchCollection
Dim M As Match
Set Reg1 = New RegExp
With Reg1
.pattern = "The Serial Number+([a-zA-Z]{4}[0-9]{1}[a-zA-Z]{2}[0-9]{7})" ' +\s*\w*\s*\w*\s* [a-zA-Z]{4}[0-9]{1}[a-zA-Z ]{2}[0-9 ]{7} \s*[a-zA-Z0-9]{7}\s*[0-9]{7}\s*
.Global = True
End With
If Reg1.test(msg.Body) Then
Set M1 = Reg1.Execute(msg.Body)
Set rng = wks.Cells(i, j)
Dim strSubject As String
Debug.Print M.SubMatches(1)
strSubject = M.SubMatches(1)
rng.Value = strSubject
j = j + 1
End If
End If
Next itm
wkb.Save
wkb.Close
MsgBox "DONE"
appExcel.Application.Visible = True
Set appExcel = GetObject(, "Excel.Application")
appExcel.Workbooks.Open (strSheet)
Set wkb = appExcel.ActiveWorkbook
Set wks = wkb.Sheets(1)
wks.Activate
End Sub
如果我使用+ \ s *(\ w *)\ s *(\ w *)\ s *,它将仅写入整个模式的最后7位数字。如果我使用ANYTHING else它只是给我对象变量或者没有设置块变量(错误91):Debug.Print M.SubMatches(1)
答案 0 :(得分:1)
请注意,在您的模式中,您量化了组而不是字符类,因此您只能捕获每个[0-9a-zA-Z]
7次,并且只有最后捕获的字母/数字存储在{ {1}}。您需要将限制量词放在组中:
Submatch(1)
请参阅regex demo
实际上,The Serial Number+\s*([0-9a-zA-Z]{7})\s*\w*\s*
^^^^
未在您当前的代码中使用,似乎是多余的。
答案 1 :(得分:0)
试试这个。
如果你的模式是4个字母,1个数字,1个空格,7个数字,1个空格,那么使用下面的行
[a-zA-Z]{4}[0-9 ]{1}[0-9 ]{7}
如果你的模式是4个字母,1个数字,2个字母,1个空格,7个数字,1个空格,那么使用下面的行
[a-zA-Z]{4}[0-9]{1}[a-zA-Z ]{2}[0-9 ]{7}