منبع یا کمی تغییرات:
http://www.ozgrid.com/forum/showthread.php?t=55298
Private Sub Command1_Click()
Dim i As Integer
For i = 1 To Len(Text1.Text)
Print HexToBin(Hex(AscW(Mid$(Text1.Text, i, 1))))
Next
End Sub
Private Function HexToBin(HexNum As String) As String
Dim BinNum As String
Dim lHexNum As Long
Dim i As Integer
lHexNum = Val("&h" & HexNum)
Do
If lHexNum And 2 ^ i Then
BinNum = "1" & BinNum
Else
BinNum = "0" & BinNum
End If
i = i + 1
Loop Until 2 ^ i > lHexNum
' Return BinNum as a String
HexToBin = BinNum
End Function