能否引用System.IO.Compression?Excel中解压Gzip压缩WebResponse遇阻
解决Excel中XMLHttpRequest接收强制Gzip压缩响应的解压问题
我太懂这种憋屈的情况了——明明设置了Accept-Encoding: identity想绕开压缩,结果服务器硬要给你发Gzip,Excel里的XMLHttpRequest又没原生解压能力,还没法引用.NET的GZipStream,简直是连环坑。下面给你几个亲测可行的方案,都不需要额外安装或者引用组件:
方案1:用Windows自带命令+临时文件解压
这个方法靠Windows内置的expand命令搞定,把压缩的响应存成临时文件,解压后再读回来,简单粗暴但有效:
Sub DecompressGzipWithTempFiles() Dim xhr As Object Set xhr = CreateObject("MSXML2.XMLHTTP.6.0") ' 发送请求,哪怕Accept-Encoding没用也写上试试 xhr.Open "GET", "你的目标API地址", False xhr.setRequestHeader "Accept-Encoding", "identity" xhr.send If xhr.Status = 200 Then ' 定义临时文件路径,用系统临时文件夹就行 Dim tempGzipPath As String, tempUnzippedPath As String tempGzipPath = Environ("TEMP") & "\temp_response.gz" tempUnzippedPath = Environ("TEMP") & "\temp_unzipped.txt" ' 把压缩的二进制响应写入临时文件 Dim stream As Object Set stream = CreateObject("ADODB.Stream") stream.Type = 1 ' 二进制模式 stream.Open stream.Write xhr.responseBody stream.SaveToFile tempGzipPath, 2 ' 覆盖已有文件 stream.Close ' 调用expand命令解压,vbHide让命令行窗口不显示 Shell "cmd /c expand """ & tempGzipPath & """ """ & tempUnzippedPath & """", vbHide ' 读取解压后的文本内容 stream.Open stream.Type = 2 ' 文本模式 stream.Charset = "UTF-8" ' 根据API返回的编码调整 stream.LoadFromFile tempUnzippedPath Dim uncompressedContent As String uncompressedContent = stream.ReadText stream.Close ' 别忘了清理临时文件 Kill tempGzipPath Kill tempUnzippedPath ' 这里就可以处理uncompressedContent里的JSON了 MsgBox "解压后的内容预览:" & Left(uncompressedContent, 500) End If End Sub
注意:如果你的系统是精简版Windows,可能没有expand命令,但绝大多数正规安装的系统都自带。另外要注意临时文件夹的读写权限,一般没问题。
方案2:内存中调用Win32 API解压(更高效)
不想生成临时文件的话,可以直接调用Windows的内核API在内存里解压,速度更快:
' 先声明Win32 API函数,64位Excel用PtrSafe,32位去掉PtrSafe,把LongPtr换成Long Private Declare PtrSafe Function CreateDecompressor Lib "kernel32.dll" (ByVal Algorithm As Long, ByVal Flags As Long, ByRef DecompressorHandle As LongPtr) As Long Private Declare PtrSafe Function Decompress Lib "kernel32.dll" (ByVal DecompressorHandle As LongPtr, ByVal Source As LongPtr, ByVal SourceSize As Long, ByVal Destination As LongPtr, ByVal DestinationSize As Long, ByRef DestinationSizeUsed As Long) As Long Private Declare PtrSafe Function CloseDecompressor Lib "kernel32.dll" (ByVal DecompressorHandle As LongPtr) As Long Const COMPRESS_ALGORITHM_GZIP As Long = 3 Sub DecompressGzipInMemory() Dim xhr As Object Set xhr = CreateObject("MSXML2.XMLHTTP.6.0") xhr.Open "GET", "你的目标API地址", False xhr.setRequestHeader "Accept-Encoding", "identity" xhr.send If xhr.Status = 200 Then Dim decompressorHandle As LongPtr Dim apiResult As Long ' 创建Gzip解压句柄 apiResult = CreateDecompressor(COMPRESS_ALGORITHM_GZIP, 0, decompressorHandle) If apiResult <> 0 Then Dim sourceBytesSize As Long sourceBytesSize = UBound(xhr.responseBody) - LBound(xhr.responseBody) + 1 ' 预估解压后的大小,这里设为原大小的10倍,你可以根据API返回调整 Dim destBufferSize As Long destBufferSize = sourceBytesSize * 10 Dim destBuffer() As Byte ReDim destBuffer(0 To destBufferSize - 1) Dim destBytesUsed As Long ' 执行内存解压 apiResult = Decompress(decompressorHandle, VarPtr(xhr.responseBody(LBound(xhr.responseBody))), sourceBytesSize, VarPtr(destBuffer(0)), destBufferSize, destBytesUsed) If apiResult <> 0 Then ' 把二进制转成文本 Dim uncompressedContent As String uncompressedContent = StrConv(Left(destBuffer, destBytesUsed), vbUnicode) ' 这里处理JSON内容就行 MsgBox "内存解压预览:" & Left(uncompressedContent, 500) Else MsgBox "解压失败,错误码:" & Err.LastDllError End If ' 一定要关闭解压句柄,避免内存泄漏 CloseDecompressor decompressorHandle Else MsgBox "创建解压句柄失败,错误码:" & Err.LastDllError End If End If End Sub
这个方法没有磁盘IO,效率更高,但要注意Excel的位数适配——32位Excel要去掉PtrSafe,把LongPtr改成Long。
方案3:纯VBA编写的Gzip解压模块
如果上面两种方法都不适用(比如系统没有expand,或者API调用有问题),可以找一个纯VBA实现的Gzip解压代码,把整个模块复制到你的Excel工程里就能用,完全不依赖任何外部工具或API。这种方法兼容性拉满,不管什么版本的Excel都能跑。
额外小技巧
- 先确认服务器确实返回了Gzip:可以用
xhr.getResponseHeader("Content-Encoding")检查,如果返回gzip就说明是压缩响应。 - 解析JSON的话,Excel VBA可以用后期绑定的
ScriptControl或者MSXML2.DOMDocument来处理,同样不需要额外引用。
内容的提问来源于stack exchange,提问作者Epiquin
相关产品推荐
相关产品推荐

