SOURCE: http://stackoverflow.com/a/14735118/935614

gistfile1.vb

Function CRC16TWICE(s As String)

Dim l As Integer, l3 As Integer
Dim s1 As String, s2 As String, s3 As String

l = Int(Len(s) / 2)
s1 = Mid(s, 1, l)
s2 = Mid(s, l + 1, l + 1)

CRC16TWICE = hash4(s1) + hash4(s2)

End Function

Function hash4(txt)
Dim x As Long
Dim mask, i, j, nC, crc As Integer
Dim c As String

crc = &HFFFF

For nC = 1 To Len(txt)
    j = asc(Mid(txt, nC))
    crc = crc Xor j
    For j = 1 To 8
        mask = 0
        If crc / 2 <> Int(crc / 2) Then mask = &HA001
        crc = Int(crc / 2) And &H7FFF: crc = crc Xor mask
    Next j
Next nC

c = Hex$(crc)

While Len(c) < 4
  c = "0" & c
Wend

hash4 = c

End Function