Получение MD5 хэша в VBA
Ещё один вариант этой функции, — для получения хеша файла:
- 24667 просмотров
Комментарии
Помог вариант без использования NET Framework. Почему-то вариант с Framework работает только со старыми версиями, а с 4.5 и 4.8 выдает ошибку.
Спасибо Вам, добрый человек! Очень помог вариант через API. Работает как надо.
Нашел решение на другом форуме через API
Считывается содержимое произвольного файла (в бинарном виде)
Так что код будет одинаковый для любого файла
Ваш ответ, на сколько я понял, позволяет получить хэш-сумму содержимого, а не файла. Это же разные вещи. Или это не так?
И также получить хэш-сумму фотографии или PDF документа в таком случае не получится, поскольку эти типы документов как правило формируются без считываемого текста.
Сначала надо считать текст из файла в переменную, потом вычислить MD5 для содержимого этой переменной (содержимого файла),
потом преобразовать полученную строку в числовое значение, и убрать знак минус (-), если он есть
Вот как-то так. Готового кода у меня нет.
Зашифрованный макропортал
1. Откройте Excel, нажмите «Файл» в верхнем левом углу, а затем выберите «Параметры» 
2. Нажмите «Пользовательская функциональная зона» 
3. Проверьте «инструмент разработчика» 
4. Выберите «Инструмент разработчика» в панели функций 
5. Выберите "Excel Display" 
6. Выберите «Обзор» 
7. Найдите позицию зашифрованного файла "MD5.xla", загрузите файл и убедитесь 
3. Используйте функцию
1. Вызовите функцию «md5_string_calc ()» к шифрованию строки, которую необходимо зашифровать 
2. <Frial Encryption, используйте собственную функцию Excel Lower (), Lower (md5_string_calc ()) 
Как захешировать данные в md5 excel
Sub FileList()
Dim V As String
Dim BrowseFolder As String
'открываем диалоговое окно выбора папки
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = «Выберите папку с разделами для экспертизы»
.Show
On Error Resume Next
Err.Clear
V = .SelectedItems(1)
If Err.Number <> 0 Then
MsgBox «Вы ничего не выбрали!»
Exit Sub
End If
End With
BrowseFolder = CStr(V)
'добавляем лист и выводим на него шапку таблицы
ActiveWorkbook.Sheets.Add.Name = «Files»
With Range(«A1:E1″)
.Font.Bold = True
.Font.Size = 12
End With
Range(«A1″).Value = «Имя файла»
Range(«B1″).Value = «Путь»
Range(«C1″).Value = «Размер»
Range(«D1″).Value = «Дата создания»
Range(«E1″).Value = «Дата изменения»
'вызываем процедуру вывода списка файлов
'измените True на False, если не нужно выводить файлы из вложенных папок
ListFilesInFolder BrowseFolder, False
End Sub
Private Sub ListFilesInFolder(ByVal SourceFolderName As String, ByVal IncludeSubfolders As Boolean)
Dim FSO As Object
Dim SourceFolder As Object
Dim SubFolder As Object
Dim FileItem As Object
Dim r As Long
Set FSO = CreateObject(«Scripting.FileSystemObject»)
Set SourceFolder = FSO.getfolder(SourceFolderName)
r = Range(«A65536″).End(xlUp).Row + 1 'находим первую пустую строку
'выводим данные по файлу
For Each FileItem In SourceFolder.Files
Cells(r, 1).Formula = FileItem.Name
Cells(r, 2).Formula = FileItem.Path
Cells(r, 3).Formula = FileItem.Size
Cells(r, 4).Formula = FileItem.DateCreated
Cells(r, 5).Formula = FileItem.DateLastModified
r = r + 1
x = SourceFolder.Path
Next FileItem
'вызываем процедуру повторно для каждой вложенной папки
If IncludeSubfolders Then
For Each SubFolder In SourceFolder.SubFolders
ListFilesInFolder SubFolder.Path, True
Next SubFolder
End If
Set FileItem = Nothing
Set SourceFolder = Nothing
Set FSO = Nothing
End Sub
MS Office Office 2010 x64 версия 14.0.7015.1000
Sub FileList()
Dim V As String
Dim BrowseFolder As String
'открываем диалоговое окно выбора папки
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = «Выберите папку с разделами для экспертизы»
.Show
On Error Resume Next
Err.Clear
V = .SelectedItems(1)
If Err.Number <> 0 Then
MsgBox «Вы ничего не выбрали!»
Exit Sub
End If
End With
BrowseFolder = CStr(V)
'добавляем лист и выводим на него шапку таблицы
ActiveWorkbook.Sheets.Add.Name = «Files»
With Range(«A1:E1″)
.Font.Bold = True
.Font.Size = 12
End With
Range(«A1″).Value = «Имя файла»
Range(«B1″).Value = «Путь»
Range(«C1″).Value = «Размер»
Range(«D1″).Value = «Дата создания»
Range(«E1″).Value = «Дата изменения»
'вызываем процедуру вывода списка файлов
'измените True на False, если не нужно выводить файлы из вложенных папок
ListFilesInFolder BrowseFolder, False
End Sub
Private Sub ListFilesInFolder(ByVal SourceFolderName As String, ByVal IncludeSubfolders As Boolean)
Dim FSO As Object
Dim SourceFolder As Object
Dim SubFolder As Object
Dim FileItem As Object
Dim r As Long
Set FSO = CreateObject(«Scripting.FileSystemObject»)
Set SourceFolder = FSO.getfolder(SourceFolderName)
r = Range(«A65536″).End(xlUp).Row + 1 'находим первую пустую строку
'выводим данные по файлу
For Each FileItem In SourceFolder.Files
Cells(r, 1).Formula = FileItem.Name
Cells(r, 2).Formula = FileItem.Path
Cells(r, 3).Formula = FileItem.Size
Cells(r, 4).Formula = FileItem.DateCreated
Cells(r, 5).Formula = FileItem.DateLastModified
r = r + 1
x = SourceFolder.Path
Next FileItem
'вызываем процедуру повторно для каждой вложенной папки
If IncludeSubfolders Then
For Each SubFolder In SourceFolder.SubFolders
ListFilesInFolder SubFolder.Path, True
Next SubFolder
End If
Set FileItem = Nothing
Set SourceFolder = Nothing
Set FSO = Nothing
End Sub
MS Office Office 2010 x64 версия 14.0.7015.1000 ArtyLight
Sub FileList()
Dim V As String
Dim BrowseFolder As String
'открываем диалоговое окно выбора папки
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = «Выберите папку с разделами для экспертизы»
.Show
On Error Resume Next
Err.Clear
V = .SelectedItems(1)
If Err.Number <> 0 Then
MsgBox «Вы ничего не выбрали!»
Exit Sub
End If
End With
BrowseFolder = CStr(V)
'добавляем лист и выводим на него шапку таблицы
ActiveWorkbook.Sheets.Add.Name = «Files»
With Range(«A1:E1″)
.Font.Bold = True
.Font.Size = 12
End With
Range(«A1″).Value = «Имя файла»
Range(«B1″).Value = «Путь»
Range(«C1″).Value = «Размер»
Range(«D1″).Value = «Дата создания»
Range(«E1″).Value = «Дата изменения»
'вызываем процедуру вывода списка файлов
'измените True на False, если не нужно выводить файлы из вложенных папок
ListFilesInFolder BrowseFolder, False
End Sub
Private Sub ListFilesInFolder(ByVal SourceFolderName As String, ByVal IncludeSubfolders As Boolean)
Dim FSO As Object
Dim SourceFolder As Object
Dim SubFolder As Object
Dim FileItem As Object
Dim r As Long
Set FSO = CreateObject(«Scripting.FileSystemObject»)
Set SourceFolder = FSO.getfolder(SourceFolderName)
r = Range(«A65536″).End(xlUp).Row + 1 'находим первую пустую строку
'выводим данные по файлу
For Each FileItem In SourceFolder.Files
Cells(r, 1).Formula = FileItem.Name
Cells(r, 2).Formula = FileItem.Path
Cells(r, 3).Formula = FileItem.Size
Cells(r, 4).Formula = FileItem.DateCreated
Cells(r, 5).Formula = FileItem.DateLastModified
r = r + 1
x = SourceFolder.Path
Next FileItem
'вызываем процедуру повторно для каждой вложенной папки
If IncludeSubfolders Then
For Each SubFolder In SourceFolder.SubFolders
ListFilesInFolder SubFolder.Path, True
Next SubFolder
End If
Set FileItem = Nothing
Set SourceFolder = Nothing
Set FSO = Nothing
End Sub
MS Office Office 2010 x64 версия 14.0.7015.1000 Автор — ArtyLight
Дата добавления — 10.03.2019 в 18:37