strZipPath = "R:\big.zip"
strExtractFileName = "abc.txt"

Set objShell = CreateObject("Shell.Application")
Set objFso = CreateObject("Scripting.FileSystemObject")
Set objFolder = objShell.NameSpace(strZipPath)
If Not objFolder Is Nothing Then
    Dim fileIndex
    fileIndex = 0
    Call RecurseZip(objFolder, "", fileIndex, strExtractFileName)
Else
    WScript.Echo "Cannot find or open the zip file."
End If

Sub RecurseZip(objFolder, strPath, ByRef fileIndex, strFileName)
    For Each objItem in objFolder.Items
        strCurrentPath = strPath & objItem.Name
        If objItem.IsFolder Then
            Call RecurseZip(objShell.NameSpace(objItem.Path), strCurrentPath & "\", fileIndex, strFileName)
        Else
            If objItem.Name = strFileName Then
                strDestPath = currentPath & Replace(strFileName, ".", "_" & fileIndex & ".")
                objShell.NameSpace(objFso.GetAbsolutePathName(".")).CopyHere objItem
                Do Until objFso.FileExists(objFso.GetAbsolutePathName(".")& "\" & strFileName)
                    WScript.Sleep 100
                Loop
                objFso.MoveFile objFso.GetAbsolutePathName(".") & "\" & objItem.Name, strDestPath
                WScript.Echo "Extracted: " & strCurrentPath & " to " & strDestPath
                fileIndex = fileIndex + 1
            End If
        End If
    Next
End Sub
复制代码