Question

我在电子邮件中有一个模式，我想在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）

Answer 1

请注意，在您的模式中，您量化了组而不是字符类，因此您只能捕获每个[0-9a-zA-Z] 7次，并且只有最后捕获的字母/数字存储在{ {1}}。您需要将限制量词放在组中：

Submatch(1)

请参阅regex demo

实际上，The Serial Number+\s*([0-9a-zA-Z]{7})\s*\w*\s* ^^^^未在您当前的代码中使用，似乎是多余的。

Answer 2

试试这个。

如果你的模式是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}

电子邮件正文中的模式未在Excel中导出

2 个答案: