File Hashing in VBA: A Detailed Guide to Generate Hashes with Various Algorithms

Photo by AltumCode on Unsplash

Introduction

File hashing is a widely-used technique to ensure the integrity of files and data. In this article, we’ll discuss how to generate file hashes using various algorithms in VBA (Visual Basic for Applications). The sample code provided will enable you to obtain file hashes in a choice of algorithms, such as MD5, SHA-1, SHA-256, SHA-384, and SHA-512.

Requirements

Before diving into the code, ensure the following requirements are met:

1. Set a reference to mscorlib 4.0 64-bit.
2. Set a reference to Microsoft Scripting Runtime.
3. Make sure that .NET Framework 3.5 (includes .NET 2 and .NET 3) is installed and enabled, not just the .NET Framework 4.8 Advanced Services.

Overview of the Sample Code

The sample code provided consists of a main subroutine TestFileHashes() and several functions to generate hashes using different algorithms. The main subroutine TestFileHashes() is used to obtain file hashes based on user settings, such as the output format (base-64 or hex), chosen file, secret key (if required), and the chosen algorithm.

The available algorithms are:

1. MD5
2. SHA-1
3. SHA-256
4. SHA-384
5. SHA-512
6. HMAC-SHA-512 (with a secret key)

Main Subroutine: TestFileHashes()

The main subroutine TestFileHashes() is responsible for obtaining the file hashes using the chosen algorithm. It starts by defining variables for user settings, such as output format, file path, secret key, and algorithm choice.

The subroutine then checks if the file path is empty or if the file size is zero or greater than 200 MB. If any of these conditions are met, the subroutine will exit.

If the file passes these checks, the hash will be generated using the chosen algorithm. The result will be output to the Immediate Window and a message box. Optionally, you can copy the result to the clipboard, append it to a file, or place it in a worksheet cell.

Functions for Different Algorithms

The sample code includes separate functions for each hashing algorithm:

1. FileToMD5()
2. FileToSHA1()
3. FileToSHA256()
4. FileToSHA384()
5. FileToSHA512()
6. FileToSHA512Salt()

Each function accepts the full file path and an optional parameter to specify whether the output should be in base-64 or hex format. The functions use the appropriate .NET cryptographic classes to generate the hashes.

Helper Functions

The sample code also includes several helper functions:

1. GetFileBytes(): Converts the file content into a byte array.
2. ConvToBase64String(): Converts the hash byte array into a base-64 string.
3. ConvToHexString(): Converts the hash byte array into a hex string.
4. GetFileSize(): Retrieves the file size in bytes.
5. AppendHashToFile(): Appends the generated hash to a specified file.

Conclusion

In this article, we have covered how to generate file hashes using various algorithms in VBA. The provided sample code can be easily customized to meet your specific needs. By implementing file hashing in your VBA applications, you can ensure the integrity of your files and data, thus improving the overall security of your projects.

Code :

Option Explicit
Public sFPath As String, sH As String

Private Sub TestFileHashes()
    'run this to obtain file hashes in a choice of algorithms
    'select any one algorithm call below
    'Limited to unrestricted files less than 200MB and not zero
    'Set a reference to mscorlib 4.0 64-bit, and Microsoft Scripting Runtime
    'Make sure that Net Framework 3.5 (includes .Net 2 and .Net 3) is installed and enabled
    'and not only the Net Framework 4.8 Advanced Services
        
    Dim b64 As Boolean, bOK As Boolean, bOK2 as Boolean
    Dim sSecret As String, nSize As Long, reply
    
    'USER SETTINGS
    '======================================================
    '======================================================
    'set output format here
    b64 = True     'true for output base-64, false for hex
    '======================================================
    'set chosen file here
    'either set path to target file in hard-typed line
    'or choose a file using the file dialog procedure
    'sFPath = "C:\Users\Your Folder\Documents\test.txt" 'eg.
    sFPath = SelectFile2("SELECT A FILE TO HASH...") 'uses file dialog
        
    'check the file
    If sFPath = "" Then 'exit sub for no file selection
        MsgBox "No selection made - closing"
        Exit Sub
    End If
    bOK = GetFileSize(sFPath, nSize)
    If nSize = 0 Or nSize > 200000000 Then 'exit sub for zero size
        MsgBox "File has zero contents or greater than 200MB - closing"
        Exit Sub
    End If
    '======================================================
    'set secret key here if using HMAC class of algorithms
    sSecret = "Set secret key for FileToSHA512Salt selection"
    '======================================================
    'choose algorithm
    'enable any one line to obtain that hash result
    'sH = FileToMD5(sFPath, b64)
    'sH = FileToSHA1(sFPath, b64)
    'sH = FileToSHA256(sFPath, b64)
    'sH = FileToSHA384(sFPath, b64)
    'sH = FileToSHA512Salt(sFPath, sSecret, b64)
    sH = FileToSHA512(sFPath, b64)
    '======================================================
    '======================================================
    
    'Results Output - open the immediate window as required
    Debug.Print sFPath & vbNewLine & sH & vbNewLine & Len(sH) & " characters in length"
    MsgBox sFPath & vbNewLine & sH & vbNewLine & Len(sH) & " characters in length"
    'reply = InputBox("The selected text can be copied with Ctrl-C", "Output is in the box...", sH)
    
    'decomment these two lines to overwrite the clipboard with the results
    bOK2 = CopyToClip(sH)
    If bOK2 = True Then MsgBox ("The result is on the clipboard.")
    
    'decomment this line to append the hash to a file (after setting its path)
    'AppendHashToFile

'decomment this block to place the hash in first cell of sheet1
'    With ThisWorkbook.Worksheets("Sheet1").Cells(1, 1)
'        .Font.Name = "Consolas"
'        .Select: Selection.NumberFormat = "@" 'make cell text
'        .Value = sH
'    End With
End Sub

Private Sub AppendHashToFile()
    Dim sFPath2 As String, fso As FileSystemObject, ts As TextStream
    Dim sContents As String, sNewContents As String
    
    sFPath2 = "C:\Users\Your Folder\Documents\test.txt" 'eg.
    Set fso = New FileSystemObject
    
    If Not Dir(sFPath2) = vbNullString Then
        'docs.microsoft.com/office/vba/language/reference/user-interface-help/opentextfile-method
        'devblogs.microsoft.com/scripting/how-can-i-add-a-line-to-the-top-of-a-text-file/
        Set ts = fso.OpenTextFile(sFPath2, ForReading)
        sContents = ts.ReadAll: ts.Close
    End If
    
    sNewContents = sH & vbTab & sFPath & vbTab & Now & vbNewLine & sContents
    sNewContents = Left(sNewContents, Len(sNewContents) - 2)
    
    Set ts = fso.OpenTextFile(sFPath2, ForWriting, True)
    ts.WriteLine sNewContents: ts.Close
End Sub

Public Function FileToMD5(sFullPath As String, Optional bB64 As Boolean = False) As String
    'parameter full path with name of file returned in the function as an MD5 hash
    'Set a reference to mscorlib 4.0 64-bit
    'Make sure that Net Framework 3.5 (includes .Net 2 and .Net 3) is installed and enabled
    'and not only the Net Framework 4.8 Advanced Services
        
    Dim enc, bytes, outstr As String, pos As Integer
    
    Set enc = CreateObject("System.Security.Cryptography.MD5CryptoServiceProvider")
    'Convert the string to a byte array and hash it
    bytes = GetFileBytes(sFullPath)
    bytes = enc.ComputeHash_2((bytes))
    
    If bB64 = True Then
       FileToMD5 = ConvToBase64String(bytes)
    Else
       FileToMD5 = ConvToHexString(bytes)
    End If
        
    Set enc = Nothing

End Function

Public Function FileToSHA1(sFullPath As String, Optional bB64 As Boolean = False) As String
    'parameter full path with name of file returned in the function as an SHA1 hash
    'Set a reference to mscorlib 4.0 64-bit
    'Make sure that Net Framework 3.5 (includes .Net 2 and .Net 3) is installed and enabled
    'and not only the Net Framework 4.8 Advanced Services
   
   Dim enc, bytes, outstr As String, pos As Integer
    
    Set enc = CreateObject("System.Security.Cryptography.SHA1CryptoServiceProvider")
    'Convert the string to a byte array and hash it
    bytes = GetFileBytes(sFullPath) 'returned as a byte array
    bytes = enc.ComputeHash_2((bytes))
    
    If bB64 = True Then
       FileToSHA1 = ConvToBase64String(bytes)
    Else
       FileToSHA1 = ConvToHexString(bytes)
    End If
        
    Set enc = Nothing

End Function

Function FileToSHA512Salt(ByVal sPath As String, ByVal sSecretKey As String, _
                           Optional ByVal bB64 As Boolean = False) As String
    'Returns a sha512 FILE HASH in function name, modified by parameter sSecretKey.
    'This hash differs from that of FileToSHA512 using the SHA512Managed class.
    'HMAC class inputs are hashed twice;first input and key are mixed before hashing,
    'then the key is mixed with the result and hashed again.
    'Set a reference to mscorlib 4.0 64-bit
    'Make sure that Net Framework 3.5 (includes .Net 2 and .Net 3) is installed and enabled
    'and not only the Net Framework 4.8 Advanced Services
    
    Dim asc As Object, enc As Object
    Dim SecretKey() As Byte
    Dim bytes() As Byte
    
    'create a text and crypto objects
    Set asc = CreateObject("System.Text.UTF8Encoding")
    
    'Any of HMACSHAMD5,HMACSHA1,HMACSHA256,HMACSHA384,or HMACSHA512 can be used
    'for corresponding hashes, albeit not matching those of Managed classes.
    Set enc = CreateObject("System.Security.Cryptography.HMACSHA512")

    'make a byte array of the text to hash
    bytes = GetFileBytes(sPath)
    
    'make a byte array of the private key
    SecretKey = asc.Getbytes_4(sSecretKey)
    'add the key property
    enc.Key = SecretKey

    'make a byte array of the hash
    bytes = enc.ComputeHash_2((bytes))
    
    'convert the byte array to string
    If bB64 = True Then
       FileToSHA512Salt = ConvToBase64String(bytes)
    Else
       FileToSHA512Salt = ConvToHexString(bytes)
    End If
    
    'release object variables
    Set asc = Nothing
    Set enc = Nothing

End Function

Public Function FileToSHA256(sFullPath As String, Optional bB64 As Boolean = False) As String
    'parameter full path with name of file returned in the function as an SHA2-256 hash
    'Set a reference to mscorlib 4.0 64-bit
    'Make sure that Net Framework 3.5 (includes .Net 2 and .Net 3) is installed and enabled
    'and not only the Net Framework 4.8 Advanced Services
    
    Dim enc, bytes, outstr As String, pos As Integer
    
    Set enc = CreateObject("System.Security.Cryptography.SHA256Managed")
    'Convert the string to a byte array and hash it
    bytes = GetFileBytes(sFullPath) 'returned as a byte array
    bytes = enc.ComputeHash_2((bytes))
    
    If bB64 = True Then
       FileToSHA256 = ConvToBase64String(bytes)
    Else
       FileToSHA256 = ConvToHexString(bytes)
    End If
        
    Set enc = Nothing

End Function

Public Function FileToSHA384(sFullPath As String, Optional bB64 As Boolean = False) As String
    'parameter full path with name of file returned in the function as an SHA2-384 hash
    'Set a reference to mscorlib 4.0 64-bit
    'Make sure that Net Framework 3.5 (includes .Net 2 and .Net 3) is installed and enabled
    'and not only the Net Framework 4.8 Advanced Services
    
    Dim enc, bytes, outstr As String, pos As Integer
    
    Set enc = CreateObject("System.Security.Cryptography.SHA384Managed")
    'Convert the string to a byte array and hash it
    bytes = GetFileBytes(sFullPath) 'returned as a byte array
    bytes = enc.ComputeHash_2((bytes))
    
    If bB64 = True Then
       FileToSHA384 = ConvToBase64String(bytes)
    Else
       FileToSHA384 = ConvToHexString(bytes)
    End If
    
    Set enc = Nothing

End Function

Public Function FileToSHA512(sFullPath As String, Optional bB64 As Boolean = False) As String
    'parameter full path with name of file returned in the function as an SHA2-512 hash
    'Set a reference to mscorlib 4.0 64-bit
    'Make sure that Net Framework 3.5 (includes .Net 2 and .Net 3) is installed and enabled
    'and not only the Net Framework 4.8 Advanced Services
    
    Dim enc, bytes, outstr As String, pos As Integer
    
    Set enc = CreateObject("System.Security.Cryptography.SHA512Managed")
    'Convert the string to a byte array and hash it
    bytes = GetFileBytes(sFullPath) 'returned as a byte array
    bytes = enc.ComputeHash_2((bytes))
    
    If bB64 = True Then
       FileToSHA512 = ConvToBase64String(bytes)
    Else
       FileToSHA512 = ConvToHexString(bytes)
    End If
    
    Set enc = Nothing

End Function

Private Function GetFileBytes(ByVal sPath As String) As Byte()
    'makes byte array from file
    'Set a reference to mscorlib 4.0 64-bit
    'Make sure that Net Framework 3.5 (includes .Net 2 and .Net 3) is installed and enabled
    'and not only the Net Framework 4.8 Advanced Services
    
    Dim lngFileNum As Long, bytRtnVal() As Byte, bTest
    
    lngFileNum = FreeFile
    
    If LenB(Dir(sPath)) Then ''// Does file exist?
        
        Open sPath For Binary Access Read As lngFileNum
        
        'a zero length file content will give error 9 here
        
        ReDim bytRtnVal(0 To LOF(lngFileNum) - 1&) As Byte
        Get lngFileNum, , bytRtnVal
        Close lngFileNum
    Else
        Err.Raise 53 'File not found
    End If
    
    GetFileBytes = bytRtnVal
    
    Erase bytRtnVal

End Function

Function ConvToBase64String(vIn As Variant) As Variant
    'used to produce a base-64 output
    'Set a reference to mscorlib 4.0 64-bit
    'Make sure that Net Framework 3.5 (includes .Net 2 and .Net 3) is installed and enabled
    'and not only the Net Framework 4.8 Advanced Services
    
    Dim oD As Object
      
    Set oD = CreateObject("MSXML2.DOMDocument")
      With oD
        .LoadXML "<root />"
        .DocumentElement.DataType = "bin.base64"
        .DocumentElement.nodeTypedValue = vIn
      End With
    ConvToBase64String = Replace(oD.DocumentElement.Text, vbLf, "")
    
    Set oD = Nothing

End Function

Function ConvToHexString(vIn As Variant) As Variant
     'used to produce a hex output
    'Set a reference to mscorlib 4.0 64-bit
    'Make sure that Net Framework 3.5 (includes .Net 2 and .Net 3) is installed and enabled
    'and not only the Net Framework 4.8 Advanced Services
    
    Dim oD As Object
      
    Set oD = CreateObject("MSXML2.DOMDocument")
      
      With oD
        .LoadXML "<root />"
        .DocumentElement.DataType = "bin.Hex"
        .DocumentElement.nodeTypedValue = vIn
      End With
    ConvToHexString = Replace(oD.DocumentElement.Text, vbLf, "")
    
    Set oD = Nothing

End Function

Function GetFileSize(sFilePath As String, nSize As Long) As Boolean
    'use this to test for a zero file size
    'takes full path as string in sFilePath
    'returns file size in bytes in nSize
    'Make a reference to Scripting Runtime
    'Make sure that Net Framework 3.5 (includes .Net 2 and .Net 3) is installed and enabled
    'and not only the Net Framework 4.8 Advanced Services
    
    Dim fs As FileSystemObject, f As File
    
    Set fs = CreateObject("Scripting.FileSystemObject")
    
    If fs.FileExists(sFilePath) Then
        Set f = fs.GetFile(sFilePath)
        nSize = f.Size
        GetFileSize = True
        Exit Function
    End If

End Function

Function SelectFile2(Optional sTitle As String = "") As String
    'opens a file-select dialog and on selection
    'returns its full path string in the function name
    'If Cancel or OK without selection, returns empty string
    'Make sure that Net Framework 3.5 (includes .Net 2 and .Net 3) is installed and enabled
    'and not only the Net Framework 4.8 Advanced Services
   
   Dim fd As FileDialog, sPathOnOpen As String, sOut As String
    
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    'do not include backslash here
    sPathOnOpen = Application.DefaultFilePath
    
    'set the file-types list on the dialog and other properties
    With fd
        .Filters.Clear
        'the first filter line below sets the default on open (here all files are listed)
        .Filters.Add "All Files", "*.*"
        .Filters.Add "Excel workbooks", "*.xlsx;*.xlsm;*.xls;*.xltx;*.xltm;*.xlt;*.xml;*.ods"
        .Filters.Add "Word documents", "*.docx;*.docm;*.dotx;*.dotm;*.doc;*.dot;*.odt"
                
        .AllowMultiSelect = False
        .InitialFileName = sPathOnOpen
        .Title = sTitle
        .InitialView = msoFileDialogViewList 'msoFileDialogViewSmallIcons
        .Show
        
        If .SelectedItems.Count = 0 Then
            'MsgBox "Canceled without selection"
            Exit Function
        Else
            sOut = .SelectedItems(1)
            'MsgBox sOut
        End If
    End With
    
    SelectFile2 = sOut

End Function

Function CopyToClip(sIn As String) As Boolean
    'passes the parameter string to the clipboard
    'set reference to Microsoft Forms 2.0 Object Library (by browsing for FM20.DLL).
    'If ref not listed, inserting user form will list it.
    'Clipboard cleared when launch application closes.
    'Make sure that Net Framework 3.5 (includes .Net 2 and .Net 3) is installed and enabled
    'and not only the Net Framework 4.8 Advanced Services
    
    Dim DataOut As DataObject
    
    Set DataOut = New DataObject
    
    'first pass textbox text to dataobject
    DataOut.SetText sIn
    
    'then pass dataobject text to clipboard
    DataOut.PutInClipboard
    
    'release object variable
    Set DataOut = Nothing
    
    CopyToClip = True
    
End Function