Question

我正在尝试从zip文件中复制特定文件。以下代码成功运行，但不会将文件从zip复制到文件夹。

任何建议都将受到赞赏..

getattr(obj, attr)

Answer 1

您遇到了这个问题，因为CStr(fileNameInZip)正在为您提供没有扩展名的文件名。

将CStr(fileNameInZip)替换为GetFilenameFromPath(fileNameInZip.Path)

并添加以下功能

Private Function GetFilenameFromPath(ByVal strPath As String) As String
    If Right$(strPath, 1) <> "\" And Len(strPath) > 0 Then
        GetFilenameFromPath = _
        GetFilenameFromPath(Left$(strPath, Len(strPath) - 1)) + Right$(strPath, 1)
    End If
End Function

现在尝试一下：）

所以你的代码看起来像这样

Sub Unzip5()
        Dim FSO As Object, oApp As Object
        Dim Fname As Variant, FileNameFolder As Variant
        Dim DefPath As String, strDate As String
        Dim I As Long, num As Long

        Fname = Application.GetOpenFilename(filefilter:="Zip Files (*.zip), *.zip", _
                                            MultiSelect:=True)
        If IsArray(Fname) = True Then
            FileNameFolder = "D:\Template\test\"

            Set oApp = CreateObject("Shell.Application")

            For I = LBound(Fname) To UBound(Fname)
                num = oApp.Namespace(FileNameFolder).Items.Count

                For Each fileNameInZip In oApp.Namespace(Fname(I)).Items
                    If fileNameInZip Like "repo*" Then
                        oApp.Namespace(FileNameFolder).CopyHere _
                        oApp.Namespace(Fname(I)).Items.Item(GetFilenameFromPath(fileNameInZip.Path))

                        Exit For
                    End If
                Next
            Next I

            MsgBox "You find the files here: " & FileNameFolder

            On Error Resume Next
            Set FSO = CreateObject("scripting.filesystemobject")
            FSO.deletefolder Environ("Temp") & "\Temporary Directory*", True
            On Error GoTo 0
        End If
    End Sub

    Private Function GetFilenameFromPath(ByVal strPath As String) As String
        If Right$(strPath, 1) <> "\" And Len(strPath) > 0 Then
            GetFilenameFromPath = _
            GetFilenameFromPath(Left$(strPath, Len(strPath) - 1)) + Right$(strPath, 1)
        End If
    End Function

从Zip文件VBA复制特定文件

1 个答案: