Skip to main content
edited tags
Link
200_success
  • 144.2k
  • 22
  • 188
  • 473
Source Link
ThunderFrame
  • 2k
  • 2
  • 15
  • 28

Hex encoding and decoding of ASCII strings in VBA

I needed to convert some Ascii text to binary in Hex format 0x00FF....

I've written an EncodeHex and a DecodeHex function to do the conversion.

I've avoided using concatenation in favour of performance.

I'm assuming that assigning the results of CByte("&h80") to a byte array, and then using StrConv to convert the array to a Unicode string, is more efficient than assigning the results of Chr$("&h80") to a string array, and then using Join to concatenate the strings.

I need to use this in Excel, so I'm using CVErr(xlErrValue) to return errors, but this could maybe benefit from being more generic.

Sample usage

?HexEncode("FooBar")
0x466F6F426172
?HexDecode("0x466F6F426172")
FooBar

VBA Code

Option Explicit

Const HEX_STRING_PREFIX As String = "0x"
Const VBA_HEX_PREFIX As String = "&h"

Public Function HexEncode(AsciiText As String, Optional HexPrefix As String = HEX_STRING_PREFIX) As String

  If AsciiText = vbNullString Then
    
    HexEncode = AsciiText
  
  Else
    
    Dim asciiChars() As Byte
    asciiChars = StrConv(AsciiText, vbFromUnicode)
    
    ReDim hexChars(LBound(asciiChars) To UBound(asciiChars)) As String
    
    Dim char As Long
    For char = LBound(asciiChars) To UBound(asciiChars)
      hexChars(char) = Right$("00" & Hex$(asciiChars(char)), 2)
    Next char
  
    HexEncode = HexPrefix & Join(hexChars, "")
  End If

End Function

Public Function HexDecode(HexString As String, Optional HexPrefix As String = HEX_STRING_PREFIX)
  
  'Check if there's anything to decode
  
  If HexString = vbNullString Then
    HexDecode = vbNullString
    Exit Function
  Else
  
    If Not StrComp(Left$(HexString, Len(HexPrefix)), HexPrefix, vbTextCompare) = 0 Then
      'Unexpected string format
      GoTo DecodeError
    End If
  
    Dim hexRaw As String
    hexRaw = Mid$(HexString, 1 + Len(HexPrefix))
    
    'Check if the string is valid for decoding
    If Len(hexRaw) Mod 2 = 1 Then
      GoTo DecodeError
    End If
    
    Dim numHexChars As Long
    numHexChars = Len(hexRaw) / 2
    
    ReDim hexChars(0 To numHexChars - 1) As Byte
    Dim char As Long
    For char = 0 To numHexChars - 1
      Dim hexchar As String
      hexchar = VBA_HEX_PREFIX & Mid$(hexRaw, 1 + char * 2, 2)
      'Check if the hex-pair is actually hex
      If Not IsNumeric(hexchar) Then
        GoTo DecodeError
      End If
      hexChars(char) = CByte(hexchar)
    Next char
    'Return the concatenated bytes as a string
    HexDecode = StrConv(hexChars, vbUnicode)
    
  End If
  
SafeExit:
  Exit Function
  
DecodeError:
  HexDecode = CVErr(xlErrValue)

End Function