遍历Zip文件提取指定Excel文件时无法获取扩展名问题排查

问题场景 #

遍历包含Zip文件的目录，提取名称含“ESG”的Excel文件时遇到两个问题：

1. 明明Zip包内的文件带.xlsx扩展名，但用GetExtensionName获取扩展名结果为空；
2. 通过CopyHere复制文件到目标目录后，文件没有.xlsx扩展名。

原代码片段 #

'Create instance of the shell application
Set obj_app = CreateObject("Shell.Application")
'Get the .zip file
Set obj_file = obj_app.Namespace((str_zip_file)).Items
'Loop through each file within the .zip file
For Each obj_stream In obj_file
    str_file = obj_stream.Name
    If obj_stream.Type Like "Microsoft Excel Worksheet" And InStr(str_file, "ESG") Then
        Set obj_target = obj_app.Namespace(obj_subfolder.Path)
        'If it's an Excel file, set the file name to `str_excel_file` and exit the loop
        str_excel_file = str_file
        obj_target.CopyHere obj_stream
        file_ext = LCase(obj_fso.GetExtensionName(obj_subfolder.Path & "\" & str_file))
        Exit For
    End If
Next obj_stream

问题原因 #

1. obj_stream.Name返回的文件名可能不含扩展名
   当系统开启“隐藏已知文件类型的扩展名”时，Shell对象返回的Name会自动去掉扩展名，导致你拿到的str_file没有.xlsx，后续GetExtensionName自然返回空，复制后的文件也丢失扩展名。
2. 依赖Type判断文件类型不可靠
   obj_stream.Type返回的是系统关联的文件类型描述（如"Microsoft Excel Worksheet"），这个值会因系统语言、Excel版本甚至注册表设置变化，不能作为稳定的判断依据。

解决方法 #

修正思路 #

• 用Shell命名空间的属性获取带扩展名的完整文件名；
• 直接通过扩展名判断是否为Excel文件，结合“ESG”关键词筛选；
• 复制时使用完整文件名，确保扩展名不丢失。

修正后的代码 #

Set obj_app = CreateObject("Shell.Application")
Set obj_fso = CreateObject("Scripting.FileSystemObject")

' 获取Zip文件的命名空间对象
Set obj_zip_namespace = obj_app.Namespace(str_zip_file)
Set obj_file_items = obj_zip_namespace.Items

For Each obj_stream In obj_file_items
    ' 属性常量20对应文件的完整名称（含扩展名）
    str_full_filename = obj_zip_namespace.GetDetailsOf(obj_stream, 20)
    
    ' 同时筛选含ESG关键词和xlsx扩展名的文件
    If InStr(str_full_filename, "ESG") > 0 And LCase(obj_fso.GetExtensionName(str_full_filename)) = "xlsx" Then
        Set obj_target = obj_app.Namespace(obj_subfolder.Path)
        str_excel_file = str_full_filename
        
        ' 复制文件，此时文件名带扩展名
        obj_target.CopyHere obj_stream
        
        ' 正常获取扩展名
        file_ext = LCase(obj_fso.GetExtensionName(obj_subfolder.Path & "\" & str_excel_file))
        Exit For
    End If
Next obj_stream

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