Regex VBA in Access - finding text between two str

2019-07-13 14:11发布

I am having a heck of a time with a RegEx question in Access VBA.

My goal is to extract the server from a linked database connection string. Basically, the connection string looks like

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

I am able to get the first regex to work, but it is returning

SERVER=compName\sqlexpress

I would like this to only return

compName\sqlexpress

My understanding is the ?<= operator should allow the RegEx to work correctly, but I get the following error "Method 'Execute' of object 'IRegExp2' failed."

The only documentation I can find for any Microsoft RegEx syntax is here which is not the runtime 5.5 VBScript library, but I'm not sure where else to get supported syntax.

Here is the code I'm using to test this. My database has a lot of linked tables.

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

Here is the function I am using:

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条回答
做个烂人
2楼-- · 2019-07-13 14:26

Here goes solution with RegEx (complete code which could be converted into function):

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

Your function changed could be as follows (I added additional parameter setting part of the pattern which should be returned):

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
查看更多
登录 后发表回答