Access中的Regex VBA - 在两个字符串之间查找文本

时间:2014-01-21 16:44:09

标签: regex vba ms-access access-vba ms-access-2010

我对Access VBA中的RegEx问题感到很沮丧。

我的目标是从链接数据库连接字符串中提取服务器。基本上,连接字符串看起来像

  

ODBC; DRIVER = SQL Server; SERVER = compName \ sqlexpress; Trusted_Connection = Yes; APP = Microsoft Office 2010; DATABASE = databaseName

我能够让第一个正则表达式工作,但它正在返回

  

SERVER = COMPNAME \ SQLEXPRESS

我希望这只返回

  

COMPNAME \ SQLEXPRESS

我的理解是?<=运算符应该允许RegEx正常工作,但是我收到以下错误“对象'IRegExp2'的方法'执行'失败。”

我可以找到的任何Microsoft RegEx语法的唯一文档是here,它不是运行时5.5 VBScript库,但我不确定在哪里可以获得支持的语法。

这是我用来测试它的代码。我的数据库有很多链表。

Sub printServerStringInformation()
    Dim rxPattern As String

    rxPattern = "(?=SERVER)(.*)(?=;Trusted)"
    Debug.Print RxMatch(CurrentDb.tableDefs(1).Connect, rxPattern, False)

    rxPattern = "(?<=SERVER)(.*)(?=;Trusted)"
    Debug.Print RxMatch(CurrentDb.tableDefs(1).Connect, rxPattern, False)

End Sub

这是我正在使用的功能:

Public Function RxMatch( _
    ByVal SourceString As String, _
    ByVal Pattern As String, _
    Optional ByVal IgnoreCase As Boolean = True, _
    Optional ByVal MultiLine As Boolean = True) As Variant
 'Microsoft VBScript Regular Expressions 5.5

    'http://www.zytrax.com/tech/web/regex.htm#more
    'http://bytecomb.com/regular-expressions-in-vba/

    'http://xkcd.com/1171/
    On Error GoTo errHandler

    Dim oMatches As MatchCollection
    With New RegExp
        .MultiLine = MultiLine
        .IgnoreCase = IgnoreCase
        .Global = False
        .Pattern = Pattern
        Set oMatches = .Execute(SourceString)
        If oMatches.Count > 0 Then
            RxMatch = oMatches(0).value
        Else
            RxMatch = ""
        End If
    End With

errHandler:
    Debug.Print Err.Description

End Function

1 个答案:

答案 0 :(得分:2)

这里是RegEx的解决方案(可以转换为函数的完整代码):

Sub qTest_3()

    Dim objRE As New RegExp
    Dim Tekst As String
    Dim Wynik As Variant


    Tekst = "ODBC;DRIVER=SQL Server;SERVER=compName\sqlexpress;Trusted_Connection=Yes;APP=Microsoft Office 2010;DATABASE=databaseName"
    With objRE
        .Global = True
        .IgnoreCase = True
        .Pattern = "(^.*;SERVER=)(.*)(;Trusted.*)" 

        Wynik = .Replace(Tekst, "$2")   'only 2nd part of the pattern will be returned

    End With
    Debug.Print Wynik

End Sub

你的功能改变如下(我添加了应该返回的模式的附加参数设置部分):

Public Function RxMatchReturn( _
    ByVal SourceString As String, _
    ByVal Pattern As String, _
    StringPart As Byte, _
    Optional ByVal IgnoreCase As Boolean = True, _
    Optional ByVal MultiLine As Boolean = True) As Variant
    'Microsoft VBScript Regular Expressions 5.5

    On Error GoTo errHandler

    Dim oMatches As MatchCollection
    With New RegExp
        .MultiLine = MultiLine
        .IgnoreCase = IgnoreCase
        .Global = True
        .Pattern = Pattern
        RxMatchReturn = .Replace(SourceString, "$" & StringPart)
    End With

errHandler:
    Debug.Print err.Description

End Function