Использование регулярного выражения с положительным lookbehind в VBA

Question

Это не код, который я написал полностью, некоторые из них были собраны вместе с одного или двух сайтов, а некоторые - то, что я установил. То, что я пытаюсь сделать, это использовать функцию регулярного выражения, определенную в regex.Pattern, чтобы посмотреть тему сообщения и извлечь значение. Это то, что я буду видеть в теме письма:

Нового сервер Linux: прод-имя_сервер-A001

До сих пор я могу получить полную тему сообщения в файл Excel, но когда я попытался для реализации части регулярного выражения я получаю код ошибки 5017 (ошибка в выражении из того, что я могу найти), и регулярное выражение не работает. Мое ожидание заключается в том, что сценарий будет тянуть тему сообщения, используйте регулярное выражение, чтобы извлечь значение и поместить его в ячейку. Я использую RegEx Builder (программу тестирования регулярных выражений) для проверки выражения, и он работает там, но не здесь. Я очень новичок в VB, поэтому я не знаю, является ли проблема в том, что VB не может использовать это выражение или если скрипт терпит неудачу где-то в другом месте, а ошибка - это что-то остаточное из другой проблемы. Или есть лучший способ написать это?

Sub ExportToExcel() 
On Error GoTo ErrHandler 

'Declarations 
    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 filePath As String 
    Dim strPath As String 
    Dim intRowCounter As Integer 
    Dim intColumnCounter As Integer 
    Dim msg As Outlook.MailItem 
    Dim nms As Outlook.NameSpace 
    Dim fld As Outlook.MAPIFolder 
    Dim itm As Object 

'RegEx Declarations 
    Dim result As String 
    Dim allMatches As Object 
    Dim regex As Object 
    Set regex = CreateObject("vbscript.regexp") 

    regex.Pattern = "(?<=Server:).*" 
    regex.Global = True 
    regex.IgnoreCase = True 


' Set the filename and path for output, requires creating the path to work 
    strSheet = "outlook.xlsx" 
    strPath = "D:\temp\" 
    filePath = strPath & strSheet 

'Debug 
Debug.Print filePath 

'Select export folder 
    Set nms = Application.GetNamespace("MAPI") 
    Set fld = nms.PickFolder 

'Handle potential errors with Select Folder dialog box. 
    If fld Is Nothing Then 
     MsgBox "There are no mail messages to export", vbOKOnly, "Error" 
     Exit Sub 

    ElseIf fld.DefaultItemType <> olMailItem Then 
     MsgBox "There are no mail messages to export", vbOKOnly, "Error" 
     Exit Sub 

    ElseIf fld.Items.Count = 0 Then 
     MsgBox "There are no mail messages to export", vbOKOnly, "Error" 
     Exit Sub 
    End If 

'Open and activate Excel workbook. 
    Set appExcel = CreateObject("Excel.Application") 
    appExcel.Workbooks.Open (filePath) 
    Set wkb = appExcel.ActiveWorkbook 
    Set wks = wkb.Sheets(1) 
    wks.Activate 
    appExcel.Application.Visible = True 


'Copy field items in mail folder. 
For Each itm In fld.Items 
    intColumnCounter = 1 
    Set msg = itm 

    If itm.UnRead = True Then 
     intRowCounter = intRowCounter + 1 
     wks.Cells(1, 1).value = "Subject" 'Row 1 Column 1 (A) 
     wks.Cells(1, 2).value = "Unread" 'Row 1 Column 2 (B) 
     wks.Cells(1, 3).value = "Server" 'Row 1 Column 3 (C) 

     Set rng = wks.Cells(intRowCounter + 1, intColumnCounter) 

     If InStr(msg.Subject, "Server:") Then 
     Set allMatches = regex.Execute(msg.Subject) 
     rng.value = allMatches 
     intColumnCounter = intColumnCounter + 1 
     msg.UnRead = False       

     Else 
      rng.value = msg.Subject 
      intColumnCounter = intColumnCounter + 1 
      msg.UnRead = False 
     End If 

     Set rng = wks.Cells(intRowCounter + 1, intColumnCounter) 
     rng.value = msg.UnRead 
     intColumnCounter = intColumnCounter + 1 
    End If 

Next itm 
Set appExcel = Nothing 
Set wkb = Nothing 
Set wks = Nothing 
Set rng = Nothing 
Set msg = Nothing 
Set nms = Nothing 
Set fld = Nothing 
Set itm = Nothing 
Exit Sub 


ErrHandler: 

If Err.Number = 1004 Then 
    MsgBox filePath & " doesn't exist", vbOKOnly, "Error" 

    ElseIf Err.Number = 13 Then 
     MsgBox Err.Number & ": Type Mismatch", vbOKOnly, "Error" 
    ElseIf Err.Number = 438 Then 
     MsgBox Err.Number & ": Object doesn't support this property or method", vbOKOnly, "Error" 
    ElseIf Err.Number = 5017 Then 
     MsgBox Err.Number & ": Error in expression", vbOKOnly, "Error" 
    Else 
     MsgBox Err.Number & ": Description: ", vbOKOnly, "Error" 

End If 


Set appExcel = Nothing 
Set wkb = Nothing 
Set wks = Nothing 
Set rng = Nothing 
Set msg = Nothing 
Set nms = Nothing 
Set fld = Nothing 
Set itm = Nothing 

End Sub 

Answer 1

VBA регулярное выражение не поддерживает просмотр назад, но в этом случае вам не нужен положительные назад ', вы можете просто использовать захват группу - «Сервер: (. *)»' - а затем получить доступ к 1-й группе значение:

Set regex = CreateObject("vbscript.regexp") 
regex.Pattern = "Server: (.*)" 
regex.IgnoreCase = True 
Set allMatches = regex.Execute("New Linux Server: prod-servername-a001") 
If allMatches.Count <> 0 Then 
    rng.Value = allMatches(0).Submatches(0) 
End If 

Здесь

• Server: - соответствует строке Server: + пробел
• (.*) - соответствует и фиксирует в группе 1 ноль или более символов, отличных от новой строки, до конца строки.

Подробнее о capturing groups.