Public Function BinHex(strBinary As String) As Long
    Dim intl As Integer
    Dim i As Integer
    Dim s As Integer
    Dim intOct As Integer
    Dim strOct As String
    
    intl = Len(strBinary)
    s = 0
    
    For i = intl To 1 Step -1
        If Mid(strBinary, i, 1) = "1" Then
        intOct = intOct + 2 ^ s
        End If
        s = s + 1
        If s = 4 Then
            strOct = intOct & strOct
            intOct = 0
            s = 0
        End If
    Next
    BinHex = intOct & strOct
End Function