電子郵件正文中的模式未在excel中導出

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個位數整個模式。如果我使用別的它只是給我上線對象沒有設置變量或與塊變量（誤差91）：Debug.Print M.SubMatches（1）

Answer 1

注意，在你的方式，你量化組而比字符類，所以你只捕獲每個[0-9a-zA-Z] 7次，只有最後捕獲的字母/數字存儲在Submatch(1)。你需要把限制量詞組內：

The Serial Number+\s*([0-9a-zA-Z]{7})\s*\w*\s* 
           ^^^^ 

見regex demo

其實，\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}