Visual Basic for Applications/Folder Hashing in VBA

From Wikibooks, open books for an open world
Jump to navigation Jump to search

Summary[edit]

Figure 1: The user form for the project. The names of controls correspond to those used in the code modules. The frames that contain OptionButtons must exist, but the frame names are arbitrary. Click the image for an enlarged view.
  • These modules are made for Microsoft Excel only. It hashes files in whole folders. It handles both flat and recursive folder listing, makes log files, and verifies files against hash files made previously.
  • Any of five hash algorithms can be used on the worksheet. They are, MD5, SHA1, SHA256, SHA384, and SHA512,. They are displayed on Sheet1 of the workbook in either hex or base64 formats. If log files are also required for these hashes, they are made in SHA512-b64 format for future verification; this format is independent of the format chosen for worksheet listings.
  • Verification results appear on Sheet2 of the workbook. Verification failures are highlighted in red. Make sure therefore that Sheet1 and Sheet2 exist in the workbook. These results can also be delivered to a log file for future use.
  • Log files, when made, are found in the default folder. Make log choices on the user form's check box options.
    • HashFile*.txt logs have a name that is date-stamped, and contains the number of files listed in it. Separate logs can be made for each run.
    • HashErr.txt is the error log. It logs file item paths that could not be hashed. There is only one of these, and the results for each run are appended with a date-time stamp. When full, just delete it and a new one will be made as required.
    • VerReport*.txt logs a copy of verification results. A separate log can be made for each verification run. It too has a date-time stamp in its file name.
  • The process is slower than FCIV, but has more algorithms to choose from. However, unlike FCIV no single file can exceed about 200MB. See File Hashing in VBA for notes on ways to hash larger files. A recursive run of the Documents folder, (2091 user files, and 1.13GB in total), took seven and a half minutes. It included writing to the worksheet, making a hash log, and logging 36 filter exclusions in an error file. Verification is faster, taking about half of that time.
  • A user form layout is shown in Figure 1. The exact control names are given, and these correspond exactly to those in code. The use of the same control names is essential for a trouble-free installation. Regrettably, there is no way in Wikibooks to download an Excel file, or for that matter the VBA code files themselves, so the main work is in the making of the user form.
  • Set filter conditions in FilterOK(). The fastest results can be had when the filter conditions are as narrow as possible. A wide range of filter conditions can be set directly in code, and for items filtered, their paths will be listed in the error file.
  • Be sure to set VBA Project references. Required are Visual Basic for Applications Extensibility 5.3, mscorlib.dll, and Microsoft Scripting Runtime, in addition to any others that you may require. The VBA editor's error setting should be Break on Unhandled Errors.
  • My Documents versus Documents. There are four virtual folders in Libraries, My Documents, My Music, My Pictures, and My Videos. When the Windows Explorer's Folder Options forbid the display of hidden files, folders, and drives and Operating system files, the correct locations are nonetheless returned by the folder selection dialogs, namely Documents, Music, Pictures, and Videos. When these folders are permitted for viewing, then selection dialogs will attempt to make use of the virtual paths, and the access violations will cause early exits with No files found. It is only by avoiding unnecessary access violations that easy listings can be obtained, so check that your folder options are set in accordance with Figure 2.

The Code Modules[edit]

Figure 2: Denied access to files can be avoided in part by ensuring that operating system files are not shown. The use of these settings will avoid many problems.

There are three modules to consider; the ThisWorkbook module, that contains the code to run automatically at startup; the Userform1 module, that contains the code for the controls themselves, and the main Module1 code that contains everything else.

  • Make sure that Sheet1 and Sheet2 exist on the workbook.
  • Then, make a user form called UserForm1, carefully using the same names as the controls in Figure 1, and in exactly the same places. Set the UserForm1 as non-modal in its properties. Save the Excel file with an *.xlsm suffix.
  • Double click the UserForm1, (not a control), in design mode, to open the code module associated with it, then copy the respective code block into it. Save the Excel file. (Saving the file in the VBE editor is exactly the same as saving on the workbook.)
  • Insert a standard module, and copy the main code listing into it. Save the file.
  • Lastly, when all other work is done, transfer the ThisWorkbook code, and save the file.
  • Set the Windows Explorer folder options in accordance with Figure 2.
  • Close the Excel workbook, then reopen it to be display the user form. If the user form is closed for any reason, it can be re-opened by running the Private Sub Workbook_Open() procedure in the ThisWorkbook module. (ie: Place cursor in the procedure then press F5.)

Using the App[edit]

There are two main functions; making hashes on the worksheet and an optional hash log, and verifying computer folders against a previously made hash log. The hashing mode also includes an optional error log, to list both errors and files avoided by the user-set filters. Verification results use an optional log of their own. Be sure to note the required Folder Options of Figure 2 before any hashing activities. ===Making hashes===

  • Set the options, recursion, output format, and hash algorithm in the topmost panel. Make log file selections on the check boxes.
  • Select a folder to hash with Select Folder to Hash. Then, pressing the Hash Folder button starts the listing on Sheet1 of the workbook.
  • Wait for the run to finish. The user form's top-caption changes to advise that the application is still processing, and message boxes advise when the run is complete. The Stop all Code button can be pressed at any time to return to the VBA editor in either of the two working modes.
  • Filtered files will be ignored in hashing. These are files deliberately avoided by user settings in the FilterOK() procedure. Such files will be listed in the error file (HashErr*.txt), if selected.
  • Log files are available for inspection, if such options were selected, located most often in the workbook's launch folder.
  • Restrict hashing to user libraries. Owing to the large numbers of hidden and otherwise restricted files in Windows, it is recommended that hashing be restricted to the contents of the user profiles. Although some files will be restricted even there, for most this is not much of a limitation, since it still includes Documents, Downloads, Music, Pictures, and Videos, and various other folders.

Verifying Folders[edit]

The verification process verifies only those file paths that are listed on the chosen hash file, and will not even consider files added to the file folders since the hash file was made. When folders are changed, new hash files need to be made in a working system.

  • Make a file selection in the bottom panel, by pressing Select File to Verify. This must be a log file (HashFile*.txt) made at an earlier time for the purpose of verification. It is the same file that can be made during a hash run, and regardless of any settings made for worksheet listing, these files will always be made as SHA512-b64 format.
  • Press Start Verification to start the process. Results are listed on Sheet2 of the worksheet, and any failures are color-highlighted. The user form caption changes to advise that the application is still processing, and message boxes advise when the process is complete.
  • Review the results , either on Sheet2 or in the verification results file (VerHash*.txt) in the default folder. Consider further action.

Code Modification Notes[edit]

  • Code modified 9 Dec 18, corrected CommandButton6_Click(), one entry wrongly marked sSht instead of oSht.
  • Code modified 5 Dec 18, corrected Module1, code error in initializing public variables.
  • Code modified 5 Dec 18, updated Module1 and UserForm1 for improved status bar reporting and sheet1 col E heading.
  • Code modified 4 Dec 18, updated Module1 and UserForm1 for more responsive output and reporting improvements.
  • Code modified 2 Dec 18, updated Module1 for error reporting improvements, and GetFileSize() larger file reporting.
  • Code modified 1 Dec 18, corrected Module1 and UserForm1 for error log issues.
  • Code modified 30 Nov 18, updated to provide algorithm selection and a new userform layout.
  • Code modified 23 Nov 18, corrected sheet number error,format all code, and remove redundant variables.
  • Code modified 23 Nov 18 updated to add verification and a new userform layout.
  • Code modified 21 Nov 18 updated to add error logging and hash logging.

ThisWorkbook Module[edit]

Private Sub Workbook_Open()
   'displays userform for
   'options and running
   
   Load UserForm1
   UserForm1.Show

End Sub

The Userform1 Module[edit]

Option Explicit
Option Compare Binary 'default,important

Private Sub CommandButton1_Click()
    'opens and returns a FOLDER path
    'using the BrowseFolder() dialog
    'Used to access the top folder for hashing
    
    'select folder
    sTargetPath = BrowseFolder("Select a folder to list...", 0)
    
    'test for cancel or closed without selection
    If sTargetPath <> "" Then
        Label2.Caption = sTargetPath 'update label with path
    Else
        Label2.Caption = "No folder selected"
        sTargetPath = ""  'public
        Exit Sub
    End If
'option compare
End Sub

Private Sub CommandButton2_Click()
    'Pauses the running code
    'Works best in combination with DoEvents
    
    MsgBox "To fully reset the code, the user should first close this message box," & vbCrLf & _
    "then select RESET on the RUN drop-menu item of the VBE editor..." & vbCrLf & _
    "If not reset, it can be started again where it paused with CONTINUE.", , "The VBA code has paused temporarily..."
    Stop
    
End Sub

Private Sub CommandButton3_Click()
    'starts the hashing run in
    'HashFolder() via RunFileListing()
    
    Dim bIsRecursive As Boolean
        
    'flat folder or recursive options
    If OptionButton2 = True Then
        bIsRecursive = True
    Else
        bIsRecursive = False
    End If
    
    'test that a folder has been selected before listing
    If Label2.Caption = "No folder selected" Or Label2.Caption = "" Then
        'no path was established
        MsgBox "First select a folder for the listing."
        Me.Caption = "Folder Hasher...Ready..."
        'Me.Repaint
        Exit Sub
    Else
        'label
        Me.Caption = "Folder Hasher...Processing...please wait."
        'make the file and hash listing
        RunFileListing sTargetPath, bIsRecursive
        Me.Caption = "Folder Hasher...Ready..."
        'Me.Repaint
    End If
    
End Sub

Private Sub CommandButton5_Click()
    'opens and returns a file path
    'using the SelectFile dialog.
    'Used to access a stored hash file
    'for a Verification run
    
    sVerifyFilePath = SelectFile("Select the file to use for Verification...")
    
    If sVerifyFilePath <> "" Then
        Label3.Caption = sVerifyFilePath
    Else
        'MsgBox "Cancelled listing"
        Label3.Caption = "No file selected"
        sVerifyFilePath = ""  'public
        Exit Sub
    End If
    
End Sub

Private Sub CommandButton6_Click()
    'runs the verification process
    'compares stored hashes with hashes made now
    'Compares case sensitive. Internal HEX is lower case a-f and integers.
    'Internal Base64 is upper letters, lower letters and integers.
        
    Dim bOK As Boolean, sAllFileText As String, vL As Variant
    Dim nLine As Long, vF As Variant, sHashPath As String, bNoPath As Boolean
    Dim sOldHash As String, sNewHash64 As String, StartTime As Single
    Dim sVerReport As String, oSht As Worksheet
    
    'format of hash files is as follows
    'path,sha512 ... ie; two fields, comma separated
    'one record per line, each line ending in a line break (vbcrlf)
    
    'fetch string from file
    If Label3.Caption = "No file selected" Or Label3.Caption = "" Then
        MsgBox "First select a file for verification"
        Exit Sub
    ElseIf GetFileSize(sVerifyFilePath) = 0 Then
        MsgBox "File contains no records"
        Exit Sub
    Else:
        bOK = GetAllFileText(sVerifyFilePath, sAllFileText)
    End If
    
    'get the system timer value
    StartTime = Timer
    
    Me.Caption = "Folder Hasher...Processing...please wait."
    
    'prepare the worksheet
    Set oSht = ThisWorkbook.Worksheets("Sheet2")
    ClearSheetContents "Sheet2"
    ClearSheetFormats "Sheet2"
    
    'split into lines -split is zero based
    vL = Split(sAllFileText, vbNewLine)
    
    'then for each line
    For nLine = LBound(vL) To UBound(vL) - 1
        DoEvents 'submit to system command stack
        'now split each line into fields on commas
        vF = Split(vL(nLine), ",")
        'obtain the path to hash from first field
        sHashPath = vF(0) 'split is zero based
        sOldHash = vF(1) 'read from file field
        
        'Check whether or not the path on the hash file exists
        bNoPath = False
        If FilePathExists(sHashPath) Then
            sNewHash64 = FileToSHA512(sHashPath, True) 'sha512-b64
        Else
            'record fact on verification report
            bNoPath = True
        End If
        
        oSht.Activate
        oSht.Cells(nLine + 2, 2) = sHashPath  'file path col 2
        If bNoPath = False Then 'the entry is for a valid path
            'if sOldHash is same as sNewHash64 then the file is verified - else not
            'prepare a verification string for filing and output line by line to worksheet
            'Debug.Print sOldHash
            'Debug.Print sNewHash64
            If sOldHash = sNewHash64 Then
                sVerReport = sVerReport & "VERIFIED OK , " & sHashPath & vbCrLf
                'export to the worksheet
                oSht.Cells(nLine + 2, 1) = "VERIFIED OK"
            Else:
                sVerReport = sVerReport & "FAILED MATCH, " & sHashPath & vbCrLf
                oSht.Cells(nLine + 2, 1) = "FAILED MATCH"
                oSht.rows(nLine + 2).Cells.Interior.Pattern = xlNone
                oSht.Cells(nLine + 2, 1).Interior.Color = RGB(227, 80, 57) 'orange-red
                oSht.Cells(nLine + 2, 2).Interior.Color = RGB(227, 80, 57) 'orange-red
            End If
        Else     'the entry is for an invalid path ie; since moved.
            sVerReport = sVerReport & "PATH NOT FOUND, " & sHashPath & vbCrLf
            oSht.Cells(nLine + 2, 1) = "PATH NOT FOUND"
            oSht.rows(nLine + 2).Cells.Interior.Pattern = xlNone
            oSht.Cells(nLine + 2, 1).Interior.Color = RGB(227, 80, 57) 'orange-red
            oSht.Cells(nLine + 2, 2).Interior.Color = RGB(227, 80, 57) 'orange-red
        End If
        
    Next nLine
    
    FormatColumnsAToB ("Sheet2")
    
    'export the report to a file
    bOK = False
    If CheckBox3 = True Then
        bOK = MakeHashLog(sVerReport, "VerReport")
    End If
    
    Me.Caption = "Folder Hasher...Ready..."
    
    'get the system timer value
    EndTime = Timer
    
    If bOK Then
        MsgBox "Verification results are on Sheet2" & vbCrLf & "and a verification log was made." & vbCrLf & _
        "The verification took " & Round((EndTime - StartTime), 2) & " seconds"
    Else
        MsgBox "Verification results are on Sheet2" & vbCrLf & _
        "The verification took " & Round((EndTime - StartTime), 2) & " seconds"
    End If
    
    Set oSht = Nothing

End Sub

Private Sub UserForm_Initialize()
    'initializes Userform1 variables
    'between form load and form show
    
    Me.Caption = "Folder Hasher...Ready..."
    OptionButton2 = True 'recursive listing default
    OptionButton3 = True 'hex output default
    OptionButton9 = True 'sha512 worksheet default
    Label2.Caption = "No folder selected"
    Label3.Caption = "No file selected"
    CheckBox1 = False 'no log
    CheckBox2 = False 'no log
    CheckBox3 = False 'no log
End Sub

The Standard Module1[edit]

Option Explicit
Option Base 1
Option Private Module
Option Compare Text 'important

Public sht1 As Worksheet          'hash results
Public StartTime As Single        'timer start
Public EndTime As Single          'timer end
Public sTargetPath As String      'selected hash folder
Public sVerifyFilePath As String  'selected verify file
Public sErrors As String          'accum output error string
Public sRecord As String          'accum output hash string
Public nErrors As Long            'accum number hash errors
Public nFilesHashed As Long       'accum number hashed files

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' modBrowseFolder
' These declarations are for the BrowseFolder() function, which displays the standard Windows Browse For Folder
' dialog. It returns the complete path of the selected folder or vbNullString if the user cancelled.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Const BIF_RETURNONLYFSDIRS As Long = &H1
Private Const BIF_DONTGOBELOWDOMAIN As Long = &H2
Private Const BIF_RETURNFSANCESTORS As Long = &H8
Private Const BIF_BROWSEFORCOMPUTER As Long = &H1000
Private Const BIF_BROWSEFORPRINTER As Long = &H2000
Private Const BIF_BROWSEINCLUDEFILES As Long = &H4000

Private Type BROWSEINFO
    hOwner As Long
    pidlRoot As Long
    pszDisplayName As String
    lpszINSTRUCTIONS As String
    ulFlags As Long
    lpfn As Long
    lParam As Long
    iImage As Long
End Type

Private Declare Function SHGetPathFromIDListA Lib "shell32.dll" (ByVal pidl As Long, _
ByVal pszBuffer As String) As Long

Private Declare Function SHBrowseForFolderA Lib "shell32.dll" (lpBrowseInfo As _
BROWSEINFO) As Long

Private Const MAX_PATH = 260 ' Windows mandated


Function BrowseFolder(Optional ByVal DialogTitle As String, _
    Optional RootCSIDL As Long = 0) As String
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' BrowseFolder
    ' This displays the standard Windows Browse Folder dialog. It returns
    ' the complete path name of the selected folder or vbNullString if the
    ' user cancelled. Depends on declarations at module heading
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ' Useful RootCSIDL values
    ' The zero default opens with a good balance of drives and folders
    ' &H5 opens with My Documents at top and nothing above.
    ' &H11 opens with the drives at the top ready to expand
    ' IMPORTANT
    ' Virtual folders, eg; "My Documents", "My MUsic", return "Documents"
    ' and "Music" provided that Windows Folder Options DO NOT SHOW HIDDEN FOLDERS
    ' and HIDE OPERATING SYSTEM FILES.  Otherwise the virtual folders
    ' themselves will be returned, with assured listing errors.
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    
    Dim uBrowseInfo As BROWSEINFO
    Dim szBuffer As String
    Dim lID As Long
    Dim lRet As Long
    
    If DialogTitle = vbNullString Then
        DialogTitle = "Select A Folder"
    End If
    
    With uBrowseInfo
        .hOwner = 0
        .pidlRoot = RootCSIDL
        .pszDisplayName = String$(MAX_PATH, vbNullChar)
        .lpszINSTRUCTIONS = DialogTitle
        .ulFlags = BIF_RETURNONLYFSDIRS ' + BIF_USENEWUI
        .lpfn = 0
    End With
    szBuffer = String$(MAX_PATH, vbNullChar)
    lID = SHBrowseForFolderA(uBrowseInfo)
    
    If lID Then
        ''' Retrieve the path string.
        lRet = SHGetPathFromIDListA(lID, szBuffer)
        If lRet Then
            BrowseFolder = Left$(szBuffer, InStr(szBuffer, vbNullChar) - 1)
        End If
    End If
    
End Function

Sub RunFileListing(sFolder As String, Optional ByVal bRecursive As Boolean = True)
    'Runs HashFolder() after worksheet prep
    'then handles output messages to user
    
    'initialize file-counting and error counting variables
    nFilesHashed = 0   'public
    nErrors = 0        'public
    sErrors = ""       'public
    sRecord = ""       'public
    StartTime = Timer  'public
    nFilesHashed = 0   'public
    
    'initialise and clear sheet1
    Set sht1 = ThisWorkbook.Worksheets("Sheet1")
    sht1.Activate
    ClearSheetContents "Sheet1"
    ClearSheetFormats "Sheet1"
    'insert sheet1 headings
    With sht1
        .Range("a1").Formula = "File Path:"
        .Range("b1").Formula = "File Size:"
        .Range("c1").Formula = "Date Created:"
        .Range("d1").Formula = "Date Last Modified:"
        .Range("e1").Formula = Algorithm 'function
        .Range("A1:E1").Font.Bold = True
        .Range("A2:E20000").Font.Bold = False
        .Range("A2:E20000").Font.Name = "Consolas"
    End With
    
    'Run the main listing procedure
    'This outputs to sheet1
    HashFolder sFolder, bRecursive
    
    'autofit sheet1 columns A to E
    With sht1
        .Range("A1").Select
        .Columns("A:E").AutoFit
        .Range("A1").Select
        .Cells.FormatConditions.Delete 'reset any conditional formatting
    End With
    
    'get the end time for the hash run
    EndTime = Timer
    
    'MAKE LOGS AS REQUIRED AND ISSUE COMPLETION MESSAGES
    Select Case nFilesHashed 'the public file counter
    Case Is <= 0 'no files hashed but still consider need for error log
        'no files hashed, errors found, error log requested
        If nErrors <> 0 And UserForm1.CheckBox2 = True Then
            '------------------------------------------------------------
            MakeErrorLog sErrors  'make an error log
            '------------------------------------------------------------
            UserForm1.Caption = "Folder Hasher...Ready..."
            MsgBox "No hashes made." & vbCrLf & nErrors & " errors noted and logged."
            'no files hashed, errors found, error log not requested
        ElseIf nErrors <> 0 And UserForm1.CheckBox2 = False Then
            UserForm1.Caption = "Folder Hasher...Ready..."
            MsgBox "No hashes made." & vbCrLf & nErrors & " errors noted but unlogged."
            'no files hashed, no errors found, no error log made regardless requested
        ElseIf nErrors = 0 Then
            UserForm1.Caption = "Folder Hasher...Ready..."
            MsgBox "No hashes made." & vbCrLf & "Error free."
        End If
    Case Is > 0 'files were hashed
        'files were hashed, hash log requested
        If UserForm1.CheckBox1 = True Then
            '------------------------------------------------------------
            MakeHashLog sRecord, "HashFile"  'make a hash log
            '------------------------------------------------------------
            UserForm1.Caption = "Folder Hasher...Ready..."
            MsgBox "A log file of these hashes was made."
            'files were hashed, no hash log requested
        Else
            UserForm1.Caption = "Folder Hasher...Ready..."
            MsgBox "No log file of these hashes was made."
        End If
        'make error files as required
        'files were hashed, errors found, error log requested
        If nErrors <> 0 And UserForm1.CheckBox2 = True Then
            '------------------------------------------------------------
            MakeErrorLog sErrors  'make an error log
            '------------------------------------------------------------
            UserForm1.Caption = "Folder Hasher...Ready..."
            MsgBox nFilesHashed & " hashes to Sheet1." & vbCrLf & nErrors & " errors noted and logged."
            'files were hashed, errors found, error log not requested
        ElseIf nErrors <> 0 And UserForm1.CheckBox2 = False Then
            UserForm1.Caption = "Folder Hasher...Ready..."
            MsgBox nFilesHashed & " hashes to Sheet1." & vbCrLf & nErrors & " errors noted but unlogged."
            'files were hashed, no errors found, no error log made regardless requested
        ElseIf nErrors = 0 Then
            UserForm1.Caption = "Folder Hasher...Ready..."
            MsgBox nFilesHashed & " hashes to Sheet1." & vbCrLf & " Error free."
        End If
    End Select
    
    'reset file counting and error counting variables
    nFilesHashed = 0   'public
    nErrors = 0
    
    'caption for completion
    UserForm1.Caption = "Folder Hasher...Ready..."
    
    'time for the hash run itself
    MsgBox "Hashes took " & Round(EndTime - StartTime, 2) & " seconds."
    
    'reset status bar
    Application.StatusBar = ""
    
    Set sht1 = Nothing

End Sub

Sub HashFolder(ByVal SourceFolderName As String, IncludeSubfolders As Boolean)
    'Called by RunFileListing() to prepare hash strings blocks for output.
    'IncludeSubfolders true for recursive listing; else flat listing of first folder only
    'b64 true for base64 output format, else hex output
    'Choice of five hash algorthms set on userform options
    'Hash log always uses sha512-b64, regardless of sheet1 algorithm selections
    'File types, inclusions and exclusions are set in FilterOK()
    
    Dim FSO As Object, SourceFolder As Object, sSuff As String, vS As Variant
    Dim SubFolder As Object, FileItem As Object, sPath As String, sReason As String
    Dim m As Long, sTemp As String, nErr As Long, nNextRow As Long
        
    'm counts accumulated file items hashed - it starts each proc run as zero.
    'nFilesHashed (public) stores accumulated value of m to that point, at the end
    'of each iteration. nErr accumulates items not hashed as errors, with nErrors
    'as its public storage variable.
    
    'transfer accumulated hash count to m on every iteration
    m = m + nFilesHashed 'file count
    nErr = nErr + nErrors 'error count
        
    On Error GoTo Errorhandler
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set SourceFolder = FSO.GetFolder(SourceFolderName)
    
    For Each FileItem In SourceFolder.Files
        DoEvents 'permits running of system commands- ie interruption
        sTemp = CStr(FileItem.Name)
        sPath = CStr(FileItem.path)
        vS = Split(CStr(FileItem.Name), "."): sSuff = vS(UBound(vS))
        
        'Raise errors for testing handler and error log here
        'If sTemp = "test.txt" Then Err.Raise 53   'Stop
        
        'running hash count and running error count to status bar
        Application.StatusBar = "Processing...Files Hashed: " & _
                                 m & " : Not Hashed: " & nErr
        
        'Decide which files are listed FilterOK()
        If FilterOK(sTemp, sPath, sReason) And Not FileItem Is Nothing Then
            m = m + 1 'increment file count within current folder
                    
            'get next sht1 row number - row one already filled with labels
            nNextRow = sht1.Range("A" & rows.Count).End(xlUp).Row + 1
            
            'send current file data and hash to worksheet
            sht1.Cells(nNextRow, 1) = CStr(FileItem.path)
            sht1.Cells(nNextRow, 2) = CLng(FileItem.Size)
            sht1.Cells(nNextRow, 3) = CDate(FileItem.DateCreated)
            sht1.Cells(nNextRow, 4) = CDate(FileItem.DateLastModified)
            sht1.Cells(nNextRow, 5) = HashString(sPath)
            
            'accumulate in string for later hash log
            'This is always sha512-b64 for consistency
            sRecord = sRecord & CStr(FileItem.path) & _
            "," & FileToSHA512(sPath, True) & vbCrLf
        
        'accumulate in string for later error log
        'for items excluded by filters
        Else
            sErrors = sErrors & FileItem.path & vbCrLf & _
            "USER FILTER: " & sReason & vbCrLf & vbCrLf
            nErr = nErr + 1   'increment error counter
        End If
    Next FileItem
    
    'increment public counter with total sourcefolder count
    nFilesHashed = m 'public nFilesHashed stores between iterations
    nErrors = nErr 'public nErrors stores between iterations
    
    'this section performs the recursion of the main procedure
    If IncludeSubfolders Then
        For Each SubFolder In SourceFolder.SubFolders
            HashFolder SubFolder.path, True
        Next SubFolder
    End If
    
    Set FileItem = Nothing
    Set SourceFolder = Nothing
    Set FSO = Nothing
    Exit Sub
    
Errorhandler:
    If Err.Number <> 0 Then
        'de-comment message box lines for more general debugging
        
        'MsgBox "When m = " & m & " in FilesToArray" & vbCrLf & _
        "Error Number :  " & Err.Number & vbCrLf & _
        "Error Description :  " & Err.Description
        
        'accumulate in string for later error log
        'for unhandled errors during resumed working
        If sPath <> "" Then   'identify path for error log
            sErrors = sErrors & sPath & vbCrLf & Err.Description & _
            " (ERR " & Err.Number & " )" & vbCrLf & vbCrLf
        Else    'note that no path is available
            sErrors = sErrors & "NO PATH COULD BE SET" & vbCrLf & _
            Err.Description & " (ERR " & Err.Number & " )" & vbCrLf & vbCrLf
        End If
        
        nErr = nErr + 1       'increment error counter
        Err.Clear             'clear the error
        Resume Next           'resume listing but errors are logged
    End If
    
End Sub

Function FilterOK(sfilename As String, sFullPath As String, sCause As String) As Boolean
    'Returns true if the file passes all tests, else false:  Early exit on test failure.
    
    'CURRENT FILTER TESTS - Keep up to date and change these in SET USER OPTIONS below.
    'Must be included in a list of permitted file types. Can be set to "all" files.
    'File type must not be specifically excluded, for example *.bak.
    'File prefix must not be specifically excluded, for example ~ for some backup files.
    'Path must not include a specified safety string in any location, eg. "MEXSIKOE", "SAFE"
    'Must not have a hidden or system file attribute set.
    'Must not have file size zero bytes (empty text file), or greater than 200 M Bytes.
    
    Dim c As Long, vP As Variant, sPrefTypes As String, bBadAttrib As Boolean
    Dim sAll As String, bExcluded As Boolean, bKeyword As Boolean, bHiddSys As Boolean
    Dim bPrefix As Boolean, bIncluded As Boolean, vPre As Variant, bSizeLimits As Boolean
    Dim sProtected As String, vK As Variant, bTest As Boolean, vInc As Variant
    Dim sExcel As String, sWord As String, sText As String, sPDF As String, sEmail As String
    Dim sVBA As String, sImage As String, sAllUser As String, vExc As Variant, nBites As Double
    Dim sFSuff As String, sIncTypes As String, sExcTypes As String, sPPoint As String
    
    'Input Conditioning
    If sfilename = "" Or sFullPath = "" Then
        'MsgBox "File name or path missing in FilterOK - closing."
        Exit Function
    Else
    End If
    
    'ASSIGNMENTS
    'SOME SUFFIX GROUP FILTER DEFINITIONS
    
    'Excel File List
    sExcel = "xl,xlsx,xlsm,xlsb,xlam,xltx,xltm,xls,xlt,xlm,xlw"
    
    'Word File List
    sWord = "docx,docm,dotx,dotm,doc,dot"
    
    'Powerpoint file list
    sPPoint = "ppt,pot,pps,pptx,pptm,potx,potm,ppam,ppsx,ppsm,sldx,sldm"
    
    'Email common list
    sEmail = "eml,msg,mbox,email,nws,mbs"
    
    'Text File List
    sText = "adr,rtf,docx,odt,txt,css,htm,html,xml,log,err"
    
    'PDF File List
    sPDF = "pdf"
    
    'VBA Code Files
    sVBA = "bas,cls,frm,frx"
    
    'Image File List
    sImage = "png,jpg,jpeg,gif,dib,bmp,jpe,jfif,ico,tif,tiff"
    
    'All User Files Added:
    'the list of all files that could be considered...
    
    'a longer list of common user files - add to it or subtract as required
    sAllUser = "xl,xlsx,xlsm,xlsb,xlam,xltx,xltm,xls,xlt,xlm,xlw," & _
    "docx,docm,dotx,dotm,doc,dot,adr,rtf,docx,odt,txt,css," & _
    "ppt,pot,pps,pptx,pptm,potx,potm,ppam,ppsx,ppsm,sldx,sldm," & _
    "htm,html,xml,log,err,pdf,bas,cls,frm,frx,png,jpg," & _
    "jpeg,gif,dib,bmp,jpe,jfif,ico,tif,tiff,zip,exe,log"
    
    sAll = ""  'using this will attempt listing EVERY file if no other restrictions
    
    'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
    'SET USER FILTER OPTIONS HERE - comma separated items in a string
    'or concatenate existing sets with a further comma string between them.
    'For example:   sIncTypes = ""                        'all types
    'sIncTypes = "log,txt"                 'just these two
    'sIncTypes = sExcel & "," & "log,txt"  'these two and excel
    'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
    
    'RESTRICT FILE TYPES WITH sIncTypes assignment
    'Eg sIncTypes = sWord & "," & sExcel  or for no restriction
    'use sAll or an empty string.
    
    sIncTypes = sAll 'choose other strings for fastest working
    
    'FURTHER SPECIFICALLY EXCLUDE THESE FILE TYPES
    'these are removed from the sIncTypes set, eg: "bas,frx,cls,frm"
    'empty string for none specified
    
    sExcTypes = ""       'empty string for no specific restriction
    
    'SPECIFICALLY EXCLUDE FILES WITH THIS PREFIX
    'eg "~", the tilde etc.
    'empty string means none specified
    
    sPrefTypes = "~"      'empty string for no specific restriction
    
    'SPECIFICALLY EXCLUDE FILE PATHS THAT CONTAIN ANY OF THESE SAFE STRINGS
    'add to the list as required
    
    sProtected = "SAFE,KEEP"   'such files are not listed
    
    'SPECIFICALLY EXCLUDE SYSTEM AND HIDDEN FILES
    'Set bHiddSys to true to exclude these files, else false
    
    bHiddSys = True  'exclude files with these attributes set
    
    'DEFAULT ENTRY- AVOIDS EMPTY FILES
    'Set bNoEmpties to true unless testing
    
    bSizeLimits = True
    
    'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
    'END OF USER FILTER OPTIONS
    'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
    
    'Working
    FilterOK = False
    bExcluded = False
    bIncluded = False
    bPrefix = False
    bKeyword = False
    
    'get the target file name suffix
    vP = Split(sfilename, ".")
    sFSuff = LCase(vP(UBound(vP))) 'work lower case comparison
    
NotBigSmall:
    'specifically exclude any empty files
    'that is, with zero bytes content
    If bSizeLimits = True Then 'check for empty files
        nBites = GetFileSize(sFullPath) 'nBites must be double
        
        If nBites = 0 Or nBites > 200000000 Then 'found one
            Select Case nBites
            Case 0
                sCause = "Zero Bytes"
            Case Is > 200000000
                sCause = "> 200MBytes"
            End Select
            FilterOK = False
            Exit Function
        End If
    End If
    
ExcludedSuffix:
    'make an array of EXCLUDED suffices
    'exit with bExcluded true if any match the target
    'or false if sExcTypes contains the empty string
    If sExcTypes = "" Then 'none excluded
        bExcluded = False
    Else
        vExc = Split(sExcTypes, ",")
        For c = LBound(vExc) To UBound(vExc)
            If sFSuff = LCase(vExc(c)) And vExc(c) <> "" Then
                bExcluded = True
                sCause = "Excluded Type"
                FilterOK = False
                Exit Function
            End If
        Next c
    End If
    
ExcludedAttrib:
    'find whether file is 'hidden' or 'system' marked
    If bHiddSys = True Then 'user excludes these
        bBadAttrib = HiddenOrSystem(sFullPath)
        If bBadAttrib Then
            sCause = "Hidden or System File"
            FilterOK = False
            Exit Function
        End If
    Else   'user does not exclude these
        bBadAttrib = False
    End If
    
Included:
    'make an array of INCLUDED suffices
    'exit with bIncluded true if any match the target
    'or if sIncTypes contains the empty string
    If sIncTypes = "" Then 'all are included
        bIncluded = True
    Else
        vInc = Split(sIncTypes, ",")
        For c = LBound(vInc) To UBound(vInc)
            If sFSuff = LCase(vInc(c)) And vInc(c) <> "" Then
                bIncluded = True
            End If
        Next c
        If bIncluded = False Then 'no match in whole list
            sCause = "Not in Main Set"
            FilterOK = False
            Exit Function
        End If
    End If
    
Prefices:
    'make an array of illegal PREFICES
    'exit with bPrefix true if any match the target
    'or false if sPrefTypes contains the empty string
    If sPrefTypes = "" Then 'none are excluded
        bPrefix = False 'no offending item found
    Else
        vPre = Split(sPrefTypes, ",")
        For c = LBound(vPre) To UBound(vPre)
            If Left(sfilename, 1) = LCase(vPre(c)) And vPre(c) <> "" Then
                bPrefix = True
                sCause = "Excluded Prefix"
                FilterOK = False
                Exit Function
            End If
        Next c
    End If
    
Keywords:
    'make an array of keywords
    'exit with bKeyword true if one is found in path
    'or false if sProtected contains the empty string
    If sProtected = "" Then 'then there are no safety words
        bKeyword = False
    Else
        vK = Split(sProtected, ",")
        For c = LBound(vK) To UBound(vK)
            bTest = sFullPath Like "*" & vK(c) & "*"
            If bTest = True Then
                bKeyword = True
                sCause = "Keyword Exclusion"
                FilterOK = False
                Exit Function
            End If
        Next c
    End If
    
    'Included catchall here pending testing completion
    If bIncluded = True And bExcluded = False And _
        bKeyword = False And bPrefix = False And _
        bBadAttrib = False Then
        FilterOK = True
    Else
        FilterOK = False
        sCause = "Unspecified"
    End If
    
End Function

Function HiddenOrSystem(sFilePath As String) As Boolean
    'Returns true if file has hidden or system attribute set,
    'else false. Called in FilterOK().
    
    Dim bReadOnly As Boolean, bHidden As Boolean, bSystem As Boolean
    Dim bVolume As Boolean, bDirectory As Boolean, a As Long
    
    'check parameter present
    If sFilePath = "" Then
        MsgBox "Empty parameter string in HiddenOrSystem - closing"
        Exit Function
    Else
    End If
    
    'check attributes for hidden or system files
    a = GetAttr(sFilePath)
    If a > 32 Then 'some attributes are set
        'so check the detailed attribute status
        bReadOnly = GetAttr(sFilePath) And 1   'read-only files in addition to files with no attributes.
        bHidden = GetAttr(sFilePath) And 2     'hidden files in addition to files with no attributes.
        bSystem = GetAttr(sFilePath) And 4     'system files in addition to files with no attributes.
        bVolume = GetAttr(sFilePath) And 8     'volume label; if any other attribute is specified, vbVolume is ignored.
        bDirectory = GetAttr(sFilePath) And 16 'directories or folders in addition to files with no attributes.
        
        'check specifically for hidden or system files - read only can be tested in the same way
        If bHidden Or bSystem Then
            'MsgBox "Has a system or hidden marking"
            HiddenOrSystem = True
            Exit Function
        Else
            'MsgBox "Has attributes but not hidden or system"
        End If
    Else
        'MsgBox "Has no attributes set"
    End If
    
End Function

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
    'called by HashString()
    'Set a reference to mscorlib 4.0 64-bit
    
    Dim enc, bytes
    
    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
    'called by HashString()
    'parameter full path with name of file returned in the function as an SHA1 hash
    'Set a reference to mscorlib 4.0 64-bit
    
    Dim enc, bytes
    
    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

Public Function FileToSHA256(sFullPath As String, Optional bB64 As Boolean = False) As String
    'called by HashString()
    '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
    
    Dim enc, bytes
    
    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
    'called by HashString()
    '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
    
    Dim enc, bytes
    
    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
    'called by HashString() and HashFolder()
    '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
    
    Dim enc, bytes
    
    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()
    'called by all of the file hashing functions
    'makes byte array from file
    'Set a reference to mscorlib 4.0 64-bit
    
    Dim lngFileNum As Long, bytRtnVal() As Byte
    
    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
    'called by all of the file hashing functions
    'used to produce a base-64 output
    'Set a reference to mscorlib 4.0 64-bit
    
    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
    'called by all of the file hashing functions
    'used to produce a hex output
    'Set a reference to mscorlib 4.0 64-bit
    
    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) As Double
    'called by CommandButton6_Click() and FilterOK() procedures
    'use this to test for a zero file size
    'takes full path as string in sFileSize
    'returns file size in bytes in nSize
    
    Dim fs As FileSystemObject, f As File
    
    Set fs = CreateObject("Scripting.FileSystemObject")
    
    If fs.FileExists(sFilePath) Then
        Set f = fs.GetFile(sFilePath)
    Else
        GetFileSize = 99999
        Exit Function
    End If
    
    GetFileSize = f.Size
    
End Function

Sub ClearSheetFormats(sht As String)
    'called by CommandButton6_Click() and RunFileListing()
    'clears text only
    
    Dim WS As Worksheet
    
    Set WS = ThisWorkbook.Worksheets(sht)
    WS.Activate
    
    With WS
        .Activate
        .UsedRange.ClearFormats
        .Cells(1, 1).Select
    End With
    
    Set WS = Nothing

End Sub

Sub ClearSheetContents(sht As String)
    'called by CommandButton6_Click() and RunFileListing()
    'clears text only
    
    Dim WS As Worksheet
    
    Set WS = ThisWorkbook.Worksheets(sht)
    
    With WS
        .Activate
        .UsedRange.ClearContents
        .Cells(1, 1).Select
    End With
    
    Set WS = Nothing

End Sub

Sub FormatColumnsAToB(sSheet As String)
    'called by CommandButton6_Click()
    'formats and autofits the columns A to I
    
    Dim sht As Worksheet
    
    Set sht = ThisWorkbook.Worksheets(sSheet)
    sht.Activate
    'sht.Cells.Interior.Pattern = xlNone
    
    'add headings
    With sht
        .Range("a1").Formula = "Verified?:"
        .Range("b1").Formula = "File Path:"
        
        .Range("A1:B1").Font.Bold = True
        .Range("A2:B20000").Font.Bold = False
        .Range("A2:B20000").Font.Name = "Consolas"
    End With
    
    'autofit columns A to B
    With sht
        .Range("A1").Select
        .Columns("A:I").AutoFit
        .Range("A1").Select
        .Cells.FormatConditions.Delete 'reset any conditional formatting
    End With
    
    Set sht = Nothing

End Sub

Function MakeErrorLog(ByVal sIn As String, Optional sLogFilePath As String = "") As Boolean
    'called by RunFileListing()
    'Appends an error log string block (sIn) for the current hash run onto an error log.
    'If optional file path not given, then uses default ThisWorkbook path and default
    'file name are used.   The default name always has HashErr as its root,
    'with an added date-time stamp. If the proposed file path exists it will be used,
    'else it will be made.  The log can safely be deleted when full.
    'Needs a VBA editor reference to Microsoft Scripting Runtime
    
    Dim fs, f, strDateTime As String, sFN As String
    
    'Make a date-time string
    strDateTime = Format(Now, "dddd, mmm d yyyy") & " - " & Format(Now, "hh:mm:ss AMPM")
    
    'select a default file name
    sFN = "HashErr.txt"
    
    'Create a scripting object
    Set fs = CreateObject("Scripting.FileSystemObject")
    
    'if path not given then get a default path instead
    If sLogFilePath = "" Then
        sLogFilePath = ThisWorkbook.path & "\" & sFN
    Else
        'some path was provided - so continue
    End If
    
    'Open file for appending text at end(8)and make if needed(1)
    On Error GoTo Err_Handler
    'set second arg to 8 for append, and 1 for read.
    Set f = fs.OpenTextFile(sLogFilePath, 8, 1)
    Err.Clear
    
    'write to file
    f.Write "These " & nErrors & " Files Could Not be Hashed" & _
    vbCrLf & strDateTime & vbCrLf & _
    vbCrLf & sIn & vbCrLf
    
    'close file
    f.Close
    
    MakeErrorLog = True
    Exit Function
    
Err_Handler:
    If Err.Number = 76 Then 'path not found
        
        'make default path for output
        sLogFilePath = ThisWorkbook.path & "\" & sFN
        
        'Open file for appending text at end(8)and make if needed(1)
        Set f = fs.OpenTextFile(sLogFilePath, 8, 1)
        
        'resume writing to file
        Resume Next
    Else:
        If Err.Number <> 0 Then
            MsgBox "Procedure MakeErrorLog has a problem : " & vbCrLf & _
            "Error number : " & Err.Number & vbCrLf & _
            "Error Description : " & Err.Description
        End If
        Exit Function
    End If
    
End Function

Function MakeHashLog(sIn As String, Optional ByVal sName As String = "HashFile") As Boolean
    'called by CommandButton6_Click() and RunFileListing()
    'Makes a one-time log for a hash run string (sIn) to be used for future verification.
    'If optional file path not given, then uses default ThisWorkbook path, and default
    'file name are used.   The default name always has HashFile as its root,
    'with an added date-time stamp. Oridinarily, such a block would be appended,
    'but the unique time stamp in the file name renders it single use.
    'If the file does not exist it will be made. The log can safely be deleted when full.
    'Needs a VBA editor reference to Microsoft Scripting Runtime
    
    Dim fs, f, sFP As String, sDateTime As String
    
    'Make a date-time string
    sDateTime = Format(Now, "ddmyy") & "_" & Format(Now, "Hhmmss")
    
    'get path for log, ie path, name, number of entries, date-time stamp, suffix
    sFP = ThisWorkbook.path & "\" & sName & "_" & sDateTime & ".txt"
    
    'set scripting object
    Set fs = CreateObject("Scripting.FileSystemObject")
    
    'make and open file
    'for appending text (8)
    'make file if not exists (1)
    Set f = fs.OpenTextFile(sFP, 8, 1)
    
    'write record to file
    'needs vbNewLine charas added to sIn
    f.Write sIn '& vbNewLine
    
    'close file
    f.Close
    
    MakeHashLog = True
    
End Function

Function FilePathExists(sFullPath As String) As Boolean
    'called by CommandButton6_Click()
    'Returns true if the file path exists, else false.
    'Add a reference to "Microsoft Scripting Runtime"
    'in the VBA editor (Tools>References).
    
    Dim FSO As Scripting.FileSystemObject
    
    Set FSO = New Scripting.FileSystemObject
    
    If FSO.FileExists(sFullPath) = True Then
        'MsgBox "File path exists"
        FilePathExists = True
    Else
        'msgbox "File path does not exist"
    End If
    
End Function

Function HashString(ByVal sFullPath As String) As String
    'called by HashFolder()
    'Returns the hash string in function name, depending
    'on the userform option buttons. Used for hash run only.
    'Verification runs use a separate dedicated call.
    
    Dim b64 As Boolean
    
    'decide hex or base64 output
    If UserForm1.OptionButton3.Value = True Then
        b64 = False
    Else
        b64 = True
    End If
    
    'decide hash algorithm
    Select Case True
    Case UserForm1.OptionButton5.Value
        HashString = FileToMD5(sFullPath, b64)    'md5
    Case UserForm1.OptionButton6.Value
        HashString = FileToSHA1(sFullPath, b64)   'sha1
    Case UserForm1.OptionButton7.Value
        HashString = FileToSHA256(sFullPath, b64) 'sha256
    Case UserForm1.OptionButton8.Value
        HashString = FileToSHA384(sFullPath, b64) 'sha384
    Case UserForm1.OptionButton9.Value
        HashString = FileToSHA512(sFullPath, b64) 'sha512
    Case Else
    End Select
    
End Function

Function Algorithm() As String
    'called by RunFileListing()
    'Returns the algorithm string based on userform1 options
    'Used only for heading labels of sheet1
    
    Dim b64 As Boolean, sFormat As String
    
    'decide hex or base64 output
    If UserForm1.OptionButton3.Value = True Then
        b64 = False
        sFormat = " - HEX"
    Else
        b64 = True
        sFormat = " - Base64"
    End If
    
    'decide hash algorithm
    Select Case True
    Case UserForm1.OptionButton5.Value
        Algorithm = "MD5 HASH" & sFormat
    Case UserForm1.OptionButton6.Value
        Algorithm = "SHA1 HASH" & sFormat
    Case UserForm1.OptionButton7.Value
        Algorithm = "SHA256 HASH" & sFormat
    Case UserForm1.OptionButton8.Value
        Algorithm = "SHA384 HASH" & sFormat
    Case UserForm1.OptionButton9.Value
        Algorithm = "SHA512 HASH" & sFormat
    Case Else
    End Select
    
End Function

Function SelectFile(sTitle As String) As String
    'called by CommandButton5_Click()
    '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
    
    Dim fd As FileDialog, sPathOnOpen As String
    
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    sPathOnOpen = "C:\Users\Internet Use\Documents\"
    
    'set the file-types list on the dialog and other properties
    fd.Filters.Clear
    fd.Filters.Add "Excel workbooks", "*.log;*.txt;*.xlsx;*.xlsm;*.xls;*.xltx;*.xltm;*.xlt;*.xml;*.ods"
    fd.Filters.Add "Word documents", "*.log;*.txt;*.docx;*.docm;*.dotx;*.dotm;*.doc;*.dot;*.odt"
    fd.Filters.Add "Executable Files", "*.log;*.txt;*.exe"
    fd.Filters.Add "All Files", "*.*"
    
    fd.AllowMultiSelect = False
    fd.InitialFileName = sPathOnOpen
    fd.Title = sTitle
    fd.InitialView = msoFileDialogViewList 'msoFileDialogViewSmallIcons
    
    'then, after pressing OK...
    If fd.Show = -1 Then ' a file has been chosen
        SelectFile = fd.SelectedItems(1)
    Else
        'no file was chosen - Cancel was selected
        'exit with proc name empty string
        'MsgBox "No file selected..."
        Exit Function
    End If
    
    'MsgBox SelectFile
    
End Function

Function GetAllFileText(sPath As String, sRet As String) As Boolean
    'called by CommandButton6_Click()
    'returns all text file content in sRet
    'makes use of Input method
    
    Dim Number As Integer
    
    'get next file number
    Number = FreeFile
    
    'Open file
    Open sPath For Input As Number
    
    'get entire file content
    sRet = Input(LOF(Number), Number)
    
    'Close File
    Close Number
    
    'transfers
    GetAllFileText = True
    
End Function

Sub NotesHashes()
    'not called
    'There are four main points in regard to GetFileBytes():
    'Does file exist:
    '1... If it does not exist then raises error 53
    ' The path will nearly always exist since it was just read from folders
    'so this problem is minimal unless the use of code is changed to read old sheets
    
    '2...If it exists but for some reason cannot be opened, protected, raises error 53
    'This one is worth dealing with - eg flash drives protect some files...xml
    'simple solution to filter out file type, but other solution unclear...
    'investigate filters for attributes and size?
    
    '3...if the file contents are zero - no text in a text file
    '- error 9 is obtained - subscripts impossible to set for array
    ' this is avoided by missing out a zero size file earlier
    'if there is even a dot in a file windows says it is 1KB
    'if there is only an empty string then it shows 0KB
    
    '4  The redim of the array should specify 0 to LOF etc in case an option base 1 is set
End Sub

See Also[edit]

External Links[edit]