使用VBA将.gz文件转换解压为.zip文件时出错求助

现有代码的问题 #

• URL拼接错误：DownloadFile过程中，myURL使用了固定的startYear而非循环变量year，导致循环内下载的始终是同一年份的文件。
• 路径分隔符错误：代码中多处使用双反斜杠\\拼接路径，VBA中单个反斜杠\即可表示路径分隔符，双反斜杠会导致生成无效路径。
• Shell解压逻辑错误：Unzip过程中，sApp.Namespace(path).items获取的是path目录下的所有文件，而非传入的目标压缩文件；且已通过参数传入具体文件路径，无需再用Dir循环遍历。
• 格式兼容性问题：Gzip与Zip是两种不同的压缩格式，仅重命名后缀无法让Shell.Application识别并解压，这是核心失败原因。

纯VBA解压.gz文件的可行方案 #

方案1：调用系统内置的expand.exe（推荐） #

Windows系统自带expand.exe工具，支持解压Gzip格式文件，无需额外安装程序。修改后的完整代码如下：

Sub getResult()
    Dim station As String
    Dim startYear As String
    Dim endYear As String
    
    startYear = "2018"
    endYear = "2022"
    
    station = "41024"
    makeFolder "C:\myfile\"
    
    Call DownloadFile(startYear, endYear, station)
End Sub

Sub makeFolder(folderPath As String)
    If Dir(folderPath, vbDirectory) = "" Then
        MkDir folderPath
    End If
End Sub

Sub DownloadFile(startYear As String, endYear As String, station As String)
    Dim year As Integer
    Dim myURL As String
    Dim path As String
    Dim path2 As String
    Dim gzFilePath As String
    Dim csvFilePath As String
    
    For year = CInt(startYear) To CInt(endYear)
        myURL = "https://bulk.meteostat.net/v2/hourly/" & year & "/" & station & ".csv.gz"
        path = "C:\myfile\" & station
        path2 = path & "\" & year
        gzFilePath = path2 & "\" & station & ".csv.gz"
        csvFilePath = path2 & "\" & station & ".csv"
        
        ' 创建目标文件夹
        makeFolder path
        makeFolder path2
        
        ' 下载.gz文件
        Dim WinHttpReq As Object
        Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
        WinHttpReq.Open "GET", myURL, False, "username", "password"
        WinHttpReq.send
        
        If WinHttpReq.Status = 200 Then
            Dim oStream As Object
            Set oStream = CreateObject("ADODB.Stream")
            oStream.Open
            oStream.Type = 1 ' 二进制模式
            oStream.Write WinHttpReq.responseBody
            oStream.SaveToFile gzFilePath, 2 ' 2 = 覆盖已存在文件
            oStream.Close
            
            ' 调用系统expand.exe解压
            Dim shellCmd As String
            shellCmd = "cmd /c ""C:\Windows\System32\expand.exe"" """ & gzFilePath & """ """ & csvFilePath & """"
            Call Shell(shellCmd, vbHide)
            
            ' 可选：删除原.gz文件
            ' Kill gzFilePath
        End If
    Next year
End Sub

方案2：纯VBA实现Gzip解压（无需外部工具） #

通过解析Gzip文件的二进制结构，结合ADODB.Stream实现纯VBA解压。以下是完整的解压函数及调用示例：

' 纯VBA解压Gzip文件核心函数
Sub GzipExtract(sourcePath As String, destPath As String)
    Dim srcStream As Object
    Dim destStream As Object
    Dim headerByte As Byte
    
    Set srcStream = CreateObject("ADODB.Stream")
    Set destStream = CreateObject("ADODB.Stream")
    
    ' 读取源.gz文件
    srcStream.Open
    srcStream.Type = 1 ' 二进制模式
    srcStream.LoadFromFile sourcePath
    
    ' 跳过Gzip文件头（固定10字节）
    srcStream.Position = 10
    
    ' 跳过可选的文件名字段（直到遇到0字节）
    Do While srcStream.Position < srcStream.Size
        headerByte = srcStream.Read(1)
        If headerByte = 0 Then Exit Do
    Loop
    
    ' 解压数据（利用ADODB内置的Deflate压缩支持）
    destStream.Open
    destStream.Type = 1
    srcStream.CopyTo destStream
    srcStream.Close
    
    ' 转换为文本模式并保存
    destStream.Position = 0
    destStream.Type = 2 ' 文本模式
    destStream.Charset = "utf-8"
    destStream.SaveToFile destPath, 2
    destStream.Close
    
    Set srcStream = Nothing
    Set destStream = Nothing
End Sub

' 修改后的DownloadFile过程，调用纯VBA解压函数
Sub DownloadFile(startYear As String, endYear As String, station As String)
    Dim year As Integer
    Dim myURL As String
    Dim path As String
    Dim path2 As String
    Dim gzFilePath As String
    Dim csvFilePath As String
    
    For year = CInt(startYear) To CInt(endYear)
        myURL = "https://bulk.meteostat.net/v2/hourly/" & year & "/" & station & ".csv.gz"
        path = "C:\myfile\" & station
        path2 = path & "\" & year
        gzFilePath = path2 & "\" & station & ".csv.gz"
        csvFilePath = path2 & "\" & station & ".csv"
        
        makeFolder path
        makeFolder path2
        
        Dim WinHttpReq As Object
        Set WinHttpReq = CreateObject("Microsoft.XMLHTTP")
        WinHttpReq.Open "GET", myURL, False, "username", "password"
        WinHttpReq.send
        
        If WinHttpReq.Status = 200 Then
            Dim oStream As Object
            Set oStream = CreateObject("ADODB.Stream")
            oStream.Open
            oStream.Type = 1
            oStream.Write WinHttpReq.responseBody
            oStream.SaveToFile gzFilePath, 2
            oStream.Close
            
            ' 调用纯VBA解压函数
            GzipExtract gzFilePath, csvFilePath
        End If
    Next year
End Sub

注意：纯VBA解压方案对部分包含额外元数据的复杂Gzip文件可能存在兼容性问题，若遇到解压失败，优先使用方案1。

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