Visual Basic for Applications/Folder Hashing in VBA
Summary
[edit | edit source]
- 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 the Libraries category of the Windows Explorer, My Documents, My Music, My Pictures, and My Videos. When the Windows Explorer's Folder Options are set to NOT display hidden files, folders, drives and Operating system files, the correct locations are nonetheless returned by the folder selection dialogs, namely Documents, Music, Pictures, and Videos. When there are NO restrictions on viewing hidden and operating system files and folders, then selection dialogs will wrongly attempt to return these virtual paths, and access violations will result. It is only by avoiding this situation that easy listings can be obtained, so check that the Folder Options of Windows Explorer are set in accordance with Figure 2.
The Code Modules
[edit | edit source]
IMPORTANT. It was found that the hash routines errored in a Windows 10, 64 bit Office setup. However, subsequent checking revealed the solution. The Windows platform must have intalled the Net Framework 3.5 (includes .Net 2 and .Net 3), this older version, and not only the Net Framework 4.8 Advanced Services that was enabled in Turn Windows Features on and off. When it was selected there, the routines worked perfectly.
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 | edit source]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
[edit | edit source]- 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 | edit source]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 | edit source]- Code modified 17 Oct 20, replaced the API version of folder selection with one that is independent of 32 or 64 bit working
- Code modified 28 Jan 19, modified SelectFile(), to set All Files as default display.
- 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 | edit source]Private Sub Workbook_Open()
'displays userform for
'options and running
Load UserForm1
UserForm1.Show
End Sub
The Userform1 Module
[edit | edit source]Option Explicit
Option Compare Binary 'default,important
Private Sub CommandButton1_Click()
'opens and returns a FOLDER path
'using the BrowseFolderExplorer() dialog
'Used to access the top folder for hashing
'select folder
sTargetPath = BrowseFolderExplorer("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 | edit source]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
Function BrowseFolderExplorer(Optional DialogTitle As String, _
Optional ViewType As MsoFileDialogView = _
MsoFileDialogView.msoFileDialogViewSmallIcons, _
Optional InitialDirectory As String) As String
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' BrowseFolderExplorer
' This provides an Explorer-like Folder Open dialog.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim fDialog As Office.FileDialog
Dim varFile As Variant
Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
'fDialog.InitialView = ViewType
With fDialog
If Dir(InitialDirectory, vbDirectory) <> vbNullString Then
.InitialFileName = InitialDirectory
Else
.InitialFileName = CurDir
End If
.Title = DialogTitle
If .Show = True Then
' user picked a folder
BrowseFolderExplorer = .SelectedItems(1)
Else
' user cancelled
BrowseFolderExplorer = vbNullString
End If
End With
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 algorithms 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
'The windows platform must have installed the '''Net Framework 3.5 (includes .Net 2 and .Net 3)'''
'and not only the '''Net Framework 4.8 Advanced Services'''
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
'The windows platform must have intalled the '''Net Framework 3.5 (includes .Net 2 and .Net 3)'''
'and not only the '''Net Framework 4.8 Advanced Services'''
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
'The windows platform must have intalled the '''Net Framework 3.5 (includes .Net 2 and .Net 3)'''
'and not only the '''Net Framework 4.8 Advanced Services'''
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
'The windows platform must have intalled the '''Net Framework 3.5 (includes .Net 2 and .Net 3)'''
'and not only the '''Net Framework 4.8 Advanced Services'''
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
'The windows platform must have intalled the '''Net Framework 3.5 (includes .Net 2 and .Net 3)'''
'and not only the '''Net Framework 4.8 Advanced Services'''
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
'The windows platform must have intalled the '''Net Framework 3.5 (includes .Net 2 and .Net 3)'''
'and not only the '''Net Framework 4.8 Advanced Services'''
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
'The windows platform must have intalled the '''Net Framework 3.5 (includes .Net 2 and .Net 3)'''
'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
'called by all of the file hashing functions
'used to produce a hex output
'Set a reference to mscorlib 4.0 64-bit
'The windows platform must have intalled the '''Net Framework 3.5 (includes .Net 2 and .Net 3)'''
'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) 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
'The windows platform must have intalled the '''Net Framework 3.5 (includes .Net 2 and .Net 3)'''
'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)
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
'The windows platform must have intalled the '''Net Framework 3.5 (includes .Net 2 and .Net 3)'''
'and not only the '''Net Framework 4.8 Advanced Services'''
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, "ddmmmyy") & "_" & 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 "All Files", "*.*"
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.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 | edit source]- File Hashing in VBA: Contains code for single file hashing, and in particular, notes on applications to hash large files.*
- String Hashing in VBA: Code for the hashing of strings.