如何使用VBA为大文件生成md5哈希？

我有以下函数为文件生成md5哈希。这些函数适用于小文件，但当我尝试对超过250 MB的文件进行散列时，会崩溃并生成运行时错误7-内存不足（我不知道它的确切大小，但低于200 MB的文件可以正常工作）

我不明白为什么它会以一定的尺寸断裂，所以如果有人能解释一下，我会非常感激

还有，我能做些什么来让函数处理更大的文件吗？我打算在一个更大的工具中使用这些函数，我需要为未知大小的文件生成哈希。大多数都足够小，可以让当前的函数工作，但我也必须能够处理大文件

我从这篇文章中最上等的答案中得到了我当前的功能

---

谢谢

看起来您已达到内存限制。 更好的方法是按块计算文件的MD5：

Public Function ComputeMD5(filepath As String) As String
  Dim buffer() As Byte, svc As Object, hFile%, blockSize&, i&
  blockSize = 2 ^ 16

  ' open the file '

  If Len(Dir(filepath)) Then Else Err.Raise 5, , "file not found" & vbCr & filepath

  hFile = FreeFile
  Open filepath For Binary Access Read As hFile

  ' allocate buffer '

  If LOF(hFile) < blockSize Then blockSize = ((LOF(hFile) + 1024) \ 1024) * 1024
  ReDim buffer(0 To blockSize - 1)

  ' compute hash '

  Set svc = CreateObject("System.Security.Cryptography.MD5CryptoServiceProvider")

  For i = 1 To LOF(hFile) \ blockSize
    Get hFile, , buffer
    svc.TransformBlock buffer, 0, blockSize, buffer, 0
  Next

  Get hFile, , buffer
  svc.TransformFinalBlock buffer, 0, LOF(hFile) Mod blockSize
  buffer = svc.Hash

  ' cleanup '

  svc.Clear
  Close hFile

  ' convert to an hexa string '

  ComputeMD5 = String$(32, "0")

  For i = 0 To 15
     Mid$(ComputeMD5, i + i + 2 + (buffer(i) > 15)) = Hex(buffer(i))
  Next

End Function

公共函数ComputeMD5（文件路径为字符串）为字符串
Dim buffer（）作为字节，svc作为对象，hFile%，blockSize&，i&
块大小=2^16
“打开文件”
如果为Len（Dir（filepath）），则为Else Err.Raise 5，“未找到文件”&vbCr&filepath
hFile=FreeFile
打开二进制访问的文件路径读取为hFile
“分配缓冲区”
如果LOF（hFile）15））=Hex（缓冲区（i））
下一个
端函数

这是对FlorentB答案的扩展，在我的文件超过2GB LOF（）大小限制之前，FlorentB的答案对我非常有用

我尝试通过以下替代方法调整文件长度：

Public Function ComputeMD5(filepath As String) As String
    If Len(Dir(filepath)) Then Else Err.Raise 5, , "File not found." & vbCr & filepath

    Dim blockSize As Long: blockSize = 2 ^ 20
    Dim blockSize_f As Double
    Dim buffer() As Byte
    Dim fileLength As Variant
    Dim hFile As Integer
    Dim n_Reads As Long
    Dim i As Long
    Dim svc As Object: Set svc = CreateObject("System.Security.Cryptography.MD5CryptoServiceProvider")

    fileLength = DecGetFileSize(filepath)
    If fileLength < blockSize Then blockSize = ((fileLength + 1024) \ 1024) * 1024
    ReDim buffer(0 To blockSize - 1)
    n_Reads = fileLength / blockSize
    blockSize_f = fileLength - (CDbl(blockSize) * n_Reads)

    hFile = FreeFile
    Open filepath For Binary Access Read As hFile
    For i = 1 To n_Reads
        Get hFile, i, buffer
        svc.TransformBlock buffer, 0, blockSize, buffer, 0
    Next i

    Get hFile, i, buffer
    svc.TransformFinalBlock buffer, 0, blockSize_f
    buffer = svc.Hash
    svc.Clear
    Close hFile

    ComputeMD5 = String$(32, "0")
    For i = 0 To 15
        Mid$(ComputeMD5, i + i + 2 + (buffer(i) > 15)) = Hex(buffer(i))
    Next

End Function

Public Function DecGetFileSize(fname As String) As Variant
    Dim fso As New FileSystemObject
    Dim f: Set f = fso.GetFile(fname)
    DecGetFileSize = CDec(f.Size)
    Set f = Nothing
    Set fso = Nothing
End Function

公共函数ComputeMD5（文件路径为字符串）为字符串
如果为Len（Dir（filepath）），则为Else Err.Raise 5，“未找到文件”。&vbCr&filepath
按长度调整块大小：块大小=2^20
暗块大小为两倍
Dim buffer（）作为字节
Dim fileLength作为变量
作为整数的Dim-hFile
Dim n_读得一样长
我想我会坚持多久
Dim svc As Object:Set svc=CreateObject（“System.Security.Cryptography.MD5CryptoServiceProvider”）
fileLength=degetfilesize（filepath）
如果fileLength15））=Hex（缓冲区（i））
下一个
端函数
作为变量的公共函数deGetFileSize（fname作为字符串）
将fso设置为新的FileSystemObject
Dim f:Set f=fso.GetFile（fname）
DeGetFileSize=CDec（f.Size）
设置f=无
设置fso=无
端函数

这一切运行正常，返回一个字符串，但是该字符串不等于在同一文件上使用其他工具计算的MD5

我想不出差异是从哪里来的

我已经检查并再次检查了filelength、n_reads、blockSize和blockSize_f，我确信这些值都是正确的

我在Get函数中遇到了一些问题，如果我没有明确告诉它块号，它将在2048块终止

---

如有任何想法/建议，将不胜感激

您是否尝试过将

intPos

改为

Long

？整数在VBA中是16位有符号的，因此限制为32767。这是一个很长的机会，因为我希望这会导致

溢出

错误，如果这是问题，但值得一试的话nontheless@Macro谢谢你的建议。问题发生在intPos发挥作用之前。错误出现在

私有函数GetFileBytes（ByVal strPath作为字符串）中的
GetFileBytes=bytRtnVal
作为Byte（）

@Florent B.哇，谢谢！那很有魅力！出于好奇，array block（）的上限值来自哪里？这是什么意思？excel中打开的文件的最大缓冲区为32767字节（1024*32-1），所以我选择的缓冲区稍小一些：31744字节（1024*31）。@Florent B.我明白了。再次感谢！：）谢谢，我很高兴能找到一个逐块MD5文件加载器的工作代码！快速提示：您不需要在

openforbinaryaccessread”语句中指定
Len=31744
，在低速网络上，1MByte块大小更好（对文件的“点击次数”更少）。事实证明，

Len`参数是

Open

语句的唯一部分，其Int限制很小，为32767:）另一个要点是：您不需要使用

FileLen（filepath）

-这只是对文件的又一次“命中”，以及所有相关的网络和磁盘延迟；在

Open

语句之后，

Length=LOF（#1）

可以立即读取打开文件句柄#1后面的字节计数。问题可能是由于隐式舍入。将

fileLength

声明为Double，并替换为

n_Reads=Fix（fileLength/blockSize）

和

fileLength-Fix（CDbl（blockSize）*n_Reads）

@FlorentB。谢谢你，但还是不行。我相信这绝对是件好事

Public Function ComputeMD5(filepath As String) As String
    If Len(Dir(filepath)) Then Else Err.Raise 5, , "File not found." & vbCr & filepath

    Dim blockSize As Long: blockSize = 2 ^ 20
    Dim blockSize_f As Double
    Dim buffer() As Byte
    Dim fileLength As Variant
    Dim hFile As Integer
    Dim n_Reads As Long
    Dim i As Long
    Dim svc As Object: Set svc = CreateObject("System.Security.Cryptography.MD5CryptoServiceProvider")

    fileLength = DecGetFileSize(filepath)
    If fileLength < blockSize Then blockSize = ((fileLength + 1024) \ 1024) * 1024
    ReDim buffer(0 To blockSize - 1)
    n_Reads = fileLength / blockSize
    blockSize_f = fileLength - (CDbl(blockSize) * n_Reads)

    hFile = FreeFile
    Open filepath For Binary Access Read As hFile
    For i = 1 To n_Reads
        Get hFile, i, buffer
        svc.TransformBlock buffer, 0, blockSize, buffer, 0
    Next i

    Get hFile, i, buffer
    svc.TransformFinalBlock buffer, 0, blockSize_f
    buffer = svc.Hash
    svc.Clear
    Close hFile

    ComputeMD5 = String$(32, "0")
    For i = 0 To 15
        Mid$(ComputeMD5, i + i + 2 + (buffer(i) > 15)) = Hex(buffer(i))
    Next

End Function

Public Function DecGetFileSize(fname As String) As Variant
    Dim fso As New FileSystemObject
    Dim f: Set f = fso.GetFile(fname)
    DecGetFileSize = CDec(f.Size)
    Set f = Nothing
    Set fso = Nothing
End Function