RegEx Help...

[Juggler_IN]

I want help with the attached function ... It takes a textual string specified by the argument x and converts every field masked with \ to its Unicode code unless it is already Unicode or masked with \. The code replaces the first match of the regular expression from the end of the string to the beginning of the string. The rest of the string remains unchanged. For example,
— RegExChr("\a\b\c\1\2\3") outputs “\a\b\c\1\2\u0033\.”
— RegExChr("\a\b\c\1\2\u0033\") outputs “\a\b\c\1\u0032\u0033\.”
— RegExChr("\a\b\c\1\u0032\u0033\") outputs “\a\b\c\u0031\u0032\u0033\.”

But, if I add the chr "\" ... is not getting converted to its Unicode value. That is,

?RegExChr("\a\b\c\1\2\3\\") gives \a\b\c\1\2\3\ but what I want is \a\b\c\1\2\3\u005C\.

?RegExChr("\a\b\c\1\2\3\u005C\") gives the expected \a\b\c\1\2\u0033\u005C\.

I tried removing Replace(RegExChr, "\\", "\") but still do not the output desired.

Any thoughts?

Function RegExChr(ByVal x As String) As String

    Dim oRegex As Object, i As Double, oCarry As Object

    If oRegex Is Nothing Then
        Set oRegex = CreateObject("vbScript.RegExp")
        oRegex.Global = True
        oRegex.Pattern = "(?:\\(\\)|\\u[0-9A-F]{4}|\\(?!\\)(.))"
    End If

    RegExChr = x

    Set oCarry = oRegex.Execute(x)

    For i = oCarry.Count - 1 To 0 Step -1
        If oCarry(i).SubMatches(1) <> Empty Then
            RegExChr = RegExHlp(oCarry(i), RegExChr, RegExAsc(oCarry(i).SubMatches(1)) & "\")
            RegExChr = Replace(RegExChr, "\\", "\")
            Exit Function
        ElseIf oCarry(i).SubMatches(0) = "\" Then
            RegExChr = RegExHlp(oCarry(i), RegExChr, "\")
            RegExChr = Replace(RegExChr, "\\", "\")
            Exit Function
        End If
    Next i

End Function
Function RegExHlp(ByRef Match As Object, ByVal s As String, ByVal r As String) As String

    RegExHlp = Left(s, Match.FirstIndex) & r & Mid(s, Match.FirstIndex + Match.Length + 1)

End Function
Function RegExAsc(ByVal s As String) As String

    If AscW(s) > 256& * 256& - 1 Then
    Else
        RegExAsc = "\u" & String(4 - Len(Hex(AscW(s))), "0") & Hex(AscW(s))
    End If

End Function

 

[Fuji]

Try replace Function RegExChr with below and see how it goes.

Function RegExChr(ByVal x As String) As String

    Dim oRegex As Object, i As Double, oCarry As Object

    If oRegex Is Nothing Then
        Set oRegex = CreateObject("vbScript.RegExp")
        oRegex.Global = True
        oRegex.Pattern = "\\u[0-9A-F]{4}|\\(.)"
    End If

    RegExChr = x

    Set oCarry = oRegex.Execute(x)

    For i = oCarry.Count - 1 To 0 Step -1
        If oCarry(i).submatches(0) <> Empty Then
            RegExChr = RegExHlp(oCarry(i), RegExChr, RegExAsc(oCarry(i).submatches(0)) & "\")
            RegExChr = Replace(RegExChr, "\\", "\")
            Exit Function
        End If
    Next i

End Function

 

[Juggler_IN]

@Fuji; This works but partly ... ?RegExChr("\\\a\b\c\\\1\2\3\\") gives \\a\b\c\\1\2\3\u005C\ ... should be \\\a\b\c\\\1\2\3\u005C\.

 

[Fuji]

I think I get what you wanted to do.
This one is capable to deal with multiple strings.

Function RegExChr(ByVal s As String)
    Dim x, mtch As Object, m As Object, i&, ref, d
    With CreateObject("VBScript.RegExp")
        .Global = True
        .Pattern = "(\\(.+?)(?=(\\|$)))"
        Set mtch = .Execute(s)
        For i = mtch.Count - 1 To 0 Step -1
            If mtch(i).submatches(1) Like "[!u]*" Then
                Set m = mtch(i)
                ref = RegExAsc(m.submatches(1))
                RegExChr = Application.Replace(s, m.firstindex + 1, m.Length, ref)
                If RegExChr Like "*[!\]" Then RegExChr = RegExChr & "\"
                Exit For
            End If
        Next
    End With
End Function

Function RegExAsc(ByVal s As String) As String
    Dim i&, t$
    For i = 1 To Len(s)
        t = Mid$(s, i, 1)
        If AscW(t) <= 256& * 256& - 1 Then
            RegExAsc = RegExAsc & "\u" & String(4 - Len(Hex(AscW(t))), "0") & Hex(AscW(t))
        End If
    Next
End Function

HEX.xlsm
	A	B	C	D	E
1	Source	Should be			Result
2	\a\b\c\1\2\3	\a\b\c\1\2\u0033\	TRUE		\a\b\c\1\2\u0033\
3	\a\b\c\1\2\u0033\	\a\b\c\1\u0032\u0033\	TRUE		\a\b\c\1\u0032\u0033\
4	\a\b\c\1\u0032\u0033\	\a\b\c\u0031\u0032\u0033\	TRUE		\a\b\c\u0031\u0032\u0033\
5	\a\b\c\1\2\3\\	\a\b\c\1\2\3\u005C\	TRUE		\a\b\c\1\2\3\u005C\
6	\a\b\c\1\2\3\u005C\	\a\b\c\1\2\u0033\u005C\	TRUE		\a\b\c\1\2\u0033\u005C\
7	\\\a\b\c\\\1\2\3\\	\\\a\b\c\\\1\2\3\u005C\	TRUE		\\\a\b\c\\\1\2\3\u005C\
8	\\\a\b\c\\\10\20\30\				\\\a\b\c\\\10\20\u0033\u0030\
Sheet1

Cell Formulas
Range	Formula
C2:C7	C2	=B2=E2
E2:E8	E2	=RegExChr(A2)

 

[Juggler_IN]

@Fuji; Thanks for all the effort ... it works!