如何获取文件上传的百分比进度？支持MSXML2.XMLHTTP/WinHTTP等

MSXML2.XMLHTTP的同步请求（Open方法第三个参数设为false）会阻塞线程，且本身没有提供上传进度的回调事件，要实现进度监控，推荐使用WinHttpRequest并采用异步模式，通过其OnProgress事件获取上传进度。

以下是完整实现示例：

1. 创建事件处理类模块 #

首先插入一个类模块（VBA编辑器中右键项目→插入→类模块），将类名改为WinHttpProgressHandler，然后写入以下代码：

Option Explicit

' 声明WinHttpRequest事件
Private WithEvents winHttp As WinHttpRequest

' 初始化事件关联
Public Sub Initialize(httpObj As WinHttpRequest)
    Set winHttp = httpObj
End Sub

' 捕获上传/下载进度事件
Private Sub winHttp_OnProgress(ByVal bytesSent As Long, ByVal bytesReceived As Long, ByVal totalBytesToSend As Long, ByVal totalBytesToReceive As Long)
    ' 计算上传进度百分比
    If totalBytesToSend > 0 Then
        Dim progressPercent As Double
        progressPercent = (bytesSent / totalBytesToSend) * 100
        ' 可替换为自定义进度展示逻辑，比如更新界面控件、打印日志
        Debug.Print "上传进度: " & Format(progressPercent, "0.00") & "% (" & bytesSent & "/" & totalBytesToSend & " bytes)"
    End If
End Sub

' 请求完成事件
Private Sub winHttp_OnResponseFinished()
    Dim responseText As String
    responseText = winHttp.ResponseText
    ' 处理接口返回结果
    Debug.Print "请求完成，响应内容: " & responseText
End Sub

' 请求出错事件
Private Sub winHttp_OnError(ByVal errorNumber As Long, ByVal errorDescription As String)
    Debug.Print "请求出错: " & errorNumber & " - " & errorDescription
End Sub

2. 主调用代码 #

在标准模块中写入以下代码，替换你原有的上传逻辑：

Option Explicit

Sub UploadFileWithProgress()
    Dim winHttp As WinHttpRequest
    Dim progressHandler As WinHttpProgressHandler
    Dim strBoundary As String
    Dim customByteData As Byte()
    Dim xSize As Long
    
    ' 1. 初始化WinHttpRequest和进度处理器
    Set winHttp = New WinHttpRequest
    Set progressHandler = New WinHttpProgressHandler
    progressHandler.Initialize winHttp
    
    ' 2. 构造multipart/form-data的边界和请求体（与你原有逻辑一致）
    strBoundary = "----Boundary" & Format(Now, "YYYYMMDDHHMMSS")
    ' 替换为你的请求体构造代码，需包含文件内容和参数
    ' customByteData = ... 
    xSize = UBound(customByteData) - LBound(customByteData) + 1 ' 计算总字节数
    
    ' 3. 配置请求
    winHttp.Open "POST", "https://aaa.com/api/token/sendfile", True ' 第三个参数设为True开启异步
    winHttp.SetRequestHeader "User-Agent", "aaa"
    winHttp.SetRequestHeader "Content-Type", "multipart/form-data; charset=utf-8; boundary=" & strBoundary
    winHttp.SetRequestHeader "Content-Length", xSize
    
    ' 4. 异步发送请求（不会阻塞线程，进度通过事件回调）
    winHttp.Send customByteData
    
    ' 5. 保持线程活跃，确保事件能被触发
    Do While winHttp.ReadyState <> 4
        DoEvents ' 处理消息循环
    Loop
    
    ' 清理对象
    Set winHttp = Nothing
    Set progressHandler = Nothing
End Sub

关键说明 #

• 异步模式：必须将Open方法的第三个参数设为True，否则无法触发OnProgress事件。
• 事件绑定：通过类模块的WithEvents声明捕获WinHttpRequest的事件，这是VBA处理COM对象事件的标准方式。
• 进度计算：OnProgress事件的bytesSent和totalBytesToSend参数分别代表已上传字节数和总字节数，据此可计算上传百分比。
• DoEvents：异步请求发送后，需通过DoEvents让程序处理消息队列，确保事件回调能被执行。

若你使用的是VBScript（而非VBA），因无法用类模块处理事件，可考虑采用分块上传结合MSXML2.XMLHTTP.6.0的onreadystatechange，但实现复杂度更高，WinHttpRequest的事件方案更可靠。

内容的提问来源于stack exchange，提问作者persi