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

Question

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

Новый сервер Linux: prod-servername-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 не поддерживает lookbehinds, но в этом случае вам не нужен позитивный lookbehind, вы просто можете использовать группу захвата - "Server: (.*)"` - и затем получить доступ к значению Group 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 ноль или более символов, кроме новой строки, до конца строки.

Смотрите больше о захвате групп.