11

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.

Peter Mortensen
  • 30,738
  • 21
  • 105
  • 131
aF.
  • 64,980
  • 43
  • 135
  • 198

2 Answers2

19

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
HK1
  • 11,941
  • 14
  • 64
  • 99
  • Quick question: The variable "asc" for the UTF8Encoding isn't used anywhere, does this serve a purpose? Also, for it to work with VBScript you will have to probably open the file using an ADODB.Stream object instead of the FreeFile method... In any case Great share! – B Hart Dec 31 '13 at 21:47
  • I think the "asc" stuff must have been artifacts from when I was using this code to hash passwords. I've removed it now. And yes, Free File doesn't exist in VBScript. I did find a function that I think could be made to work that uses the File System Object: http://stackoverflow.com/questions/6060529/read-and-write-binary-file-in-vbscript – HK1 Jan 03 '14 at 00:22
  • Good solution, with a couple of nits to pick... `Dim bytes() As Byte` offers a small gain; and passing it by reference into a reconfigured `Private Sub GetFileBytes(sFileName As String, arrBytes() As Byte)` means that you sidestep a redundant memory allocation - and that's a *real* gain, for resource usage and performance. The elephant in the room is that, for really large files, `ReDim bytRtnVal(LOF(lngFileNum) - 1&) As Byte` will raise errors. But I can't post anything better, because I do not know of any 'chunking' or streaming API into the System.Security.Cryptography functions. – Nigel Heffernan Dec 29 '17 at 11:22
  • Update: user Florent B. posted an answer with data passed in chunks to the MD5 hashing service in [this StackOverflow answer](https://stackoverflow.com/a/36331066/362712) – Nigel Heffernan Dec 29 '17 at 15:37
  • @HK1 Why the double parens in `bytes = enc.ComputeHash_2((bytes))`? – mbmast May 27 '23 at 17:58
-1

This should do it:

        Dim fileBytes() As Byte = File.ReadAllBytes(path:=fullPath)
        Dim Md5 As New MD5CryptoServiceProvider()
        Dim byteHash() As Byte = Md5.ComputeHash(fileBytes)
        Return Convert.ToBase64String(byteHash)
  • Huh? First, that's VB.NET not VBA and second, you're omitting some very important Import commands. – Ben Aug 13 '12 at 21:05
  • Oops, I had mis-read VBA as VB.NET. VBA would be a fair bit harder, since it does not have all of the .NET framework support that makes the above code so simple. As for imports, Visual Studio will probably suggest those for you automatically, but for completion's sake, they are System.IO and System.Security.Cryptography. – Michael Zlatkovsky - Microsoft Aug 19 '12 at 23:35