How can I get the MD5 hex hash for a file using VBA?
I need a version that works for a file.
Something as simple as this Python code:
import hashlib
def md5_for_file(fileLocation, block_size=2**20):
f = open(fileLocation)
md5 = hashlib.md5()
while True:
data = f.read(block_size)
if not data:
break
md5.update(data)
f.close()
return md5.hexdigest()
But in VBA.
An older question that could use a better answer. These functions are specifically for hashing files, not for hashing passwords. As a bonus, I'm including a function for SHA1. If you get rid of the type declarations these functions work in VBScript too except that the GetFileBytes function needs to be changed to use FileSystemObject (or possibly ADO Stream) as the Free File doesn't exist in VBScript.
Private Sub TestMD5()
Debug.Print FileToMD5Hex("C:\test.txt")
Debug.Print FileToSHA1Hex("C:\test.txt")
End Sub
Public Function FileToMD5Hex(sFileName As String) As String
Dim enc
Dim bytes
Dim outstr As String
Dim pos As Integer
Set enc = CreateObject("System.Security.Cryptography.MD5CryptoServiceProvider")
'Convert the string to a byte array and hash it
bytes = GetFileBytes(sFileName)
bytes = enc.ComputeHash_2((bytes))
'Convert the byte array to a hex string
For pos = 1 To LenB(bytes)
outstr = outstr & LCase(Right("0" & Hex(AscB(MidB(bytes, pos, 1))), 2))
Next
FileToMD5Hex = outstr
Set enc = Nothing
End Function
Public Function FileToSHA1Hex(sFileName As String) As String
Dim enc
Dim bytes
Dim outstr As String
Dim pos As Integer
Set enc = CreateObject("System.Security.Cryptography.SHA1CryptoServiceProvider")
'Convert the string to a byte array and hash it
bytes = GetFileBytes(sFileName)
bytes = enc.ComputeHash_2((bytes))
'Convert the byte array to a hex string
For pos = 1 To LenB(bytes)
outstr = outstr & LCase(Right("0" & Hex(AscB(MidB(bytes, pos, 1))), 2))
Next
FileToSHA1Hex = outstr 'Returns a 40 byte/character hex string
Set enc = Nothing
End Function
Private Function GetFileBytes(ByVal path As String) As Byte()
Dim lngFileNum As Long
Dim bytRtnVal() As Byte
lngFileNum = FreeFile
If LenB(Dir(path)) Then ''// Does file exist?
Open path For Binary Access Read As lngFileNum
ReDim bytRtnVal(LOF(lngFileNum) - 1&) As Byte
Get lngFileNum, , bytRtnVal
Close lngFileNum
Else
Err.Raise 53
End If
GetFileBytes = bytRtnVal
Erase bytRtnVal
End Function