在VBA中使用正向lookbehind的正则expression式

这不是我完全写的代码，有的是从一两个网站拼凑而成的，有的是我设定的。 我想要做的是使用regex.Pattern中定义的正则expression式来查看邮件主题并提取一个值。 这是我要在电子邮件主题中看到的内容：

新的Linux服务器：prod-servername-a001

到目前为止，我可以得到完整的消息主题到Excel文件，但是当我试图实现正则expression式的部分，我得到一个错误代码5017（从我能find的expression式中的错误）和正则expression式不是“工作”。 我的期望是脚本将拉动消息主题，使用正则expression式提取值并将其放置在单元格中。 我正在使用正则expression式生成器（正则expression式testing程序）来testingexpression式，它在那里工作，但不在这里。 我很新的VB，所以我不知道是否VB不能使用这个expression式，或者如果脚本失败其他地方，错误是残留的另一个问题。 还是有更好的方法来写这个？

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的正则expression式不支持向后看，但在这种情况下，你不需要积极lookbehind，你可以使用捕获组 – “服务器：（。*）” – 然后访问组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: – 匹配一个stringServer: +空间
• (.*) – 匹配并捕获到第1组零个或更多字符，而不是直到行尾的换行符。

查看更多关于捕获组的信息