PDA

View Full Version : Listing the files from a compressed zipped folders


dm28949
02-10-2015, 02:17 PM
This is the code I found to list the files that are on the zipped folders. What changes should I make to this code so that it displays the files with their extensions and also the size of each files that are in zipped folders.

Any help will be much appreciated!


Private Type BROWSEINFO ' used by the function GetFolderName
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type

Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long

Public i As Integer, FName As String, Fname2 As String, mypath As String
Function GetFolderName(Msg As String) As String
' returns the name of the folder selected by the user
Dim bInfo As BROWSEINFO, path As String, r As Long
Dim X As Long, pos As Integer
bInfo.pidlRoot = 0& ' Root folder = Desktop
If IsMissing(Msg) Then
bInfo.lpszTitle = "Select a folder."
' the dialog title
Else
bInfo.lpszTitle = Msg ' the dialog title
End If
bInfo.ulFlags = &H1 ' Type of ucase(Dir)ectory to return
X = SHBrowseForFolder(bInfo) ' display the dialog
' Parse the result
path = Space$(512)
r = SHGetPathFromIDList(ByVal X, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetFolderName = Left(path, pos - 1)
Else
GetFolderName = ""
End If
End Function


Sub ListZipDetails()
Dim FSO As Object
Dim oApp As Object
' Dim FName As Variant
' Dim FileNameFolder As Variant
' Dim DefPath As String
' Dim strDate As String
Dim fileNameInZip As Variant
Application.DisplayAlerts = False
Application.ScreenUpdating = False

Application.EnableCancelKey = xlDisabled

Workbooks.Add
Sheets(2).Delete
Sheets(2).Delete
Range("A1").Value = "Zip File Name"
Range("B1").Value = "Sub Folder"
Range("C1").Value = "File Name"

i = 2

mypath = GetFolderName("Select Folder where Data Files are stored")

If mypath = "" Then
Exit Sub
End If
'Fcount = CountFiles(mypath, "txt")

If Right(mypath, 1) <> "\" Then
mypath = mypath & "\"
End If

FName = Dir(mypath)

Do While FName <> ""

If UCase(FName) Like "*.ZIP" Then
Fname2 = ""


Call ListZip(mypath & FName)
End If

FName = Dir
Loop

End Sub

Public Sub ListZip(SrcFile)
Set oApp = CreateObject("Shell.Application")

For Each fileNameInZip In oApp.Namespace(SrcFile).Items
If fileNameInZip.IsFolder = True Then 'Or Right(fileNameInZip, 3) = "zip" Then
If Fname2 = "" Then
Fname2 = fileNameInZip
Else
Fname2 = Fname2 & "\" & fileNameInZip
End If

Call ListZip(fileNameInZip)
Else
Range("A" & i).Value = FName
Range("B" & i).Value = Fname2
Range("C" & i).Value = fileNameInZip

i = i + 1
End If
Next
If Fname2 <> "" Then
Fname2 = Left(Fname2, Len(Fname2) - Len(SrcFile))
If Right(Fname2, 1) = "\" Then
Fname2 = Left(Fname2, Len(Fname2) - 1)
End If

End If
Set oApp = Nothing



End Sub
JKwan
02-11-2015, 08:47 AM
Is this what you mean:

As to extension that you are asking.... It is being displayed, unless I misunderstood.

Private Type BROWSEINFO ' used by the function GetFolderName
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Private Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Public i As Integer, FName As String, Fname2 As String, mypath As String
Function GetFolderName(Msg As String) As String
' returns the name of the folder selected by the user
Dim bInfo As BROWSEINFO, path As String, r As Long
Dim X As Long, pos As Integer
bInfo.pidlRoot = 0& ' Root folder = Desktop
If IsMissing(Msg) Then
bInfo.lpszTitle = "Select a folder."
' the dialog title
Else
bInfo.lpszTitle = Msg ' the dialog title
End If
bInfo.ulFlags = &H1 ' Type of ucase(Dir)ectory to return
X = SHBrowseForFolder(bInfo) ' display the dialog
' Parse the result
path = Space$(512)
r = SHGetPathFromIDList(ByVal X, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetFolderName = Left(path, pos - 1)
Else
GetFolderName = ""
End If
End Function
Sub ListZipDetails()
Dim FSO As Object
Dim oApp As Object
' Dim FName As Variant
' Dim FileNameFolder As Variant
' Dim DefPath As String
' Dim strDate As String
Dim fileNameInZip As Variant
Application.DisplayAlerts = False
Application.ScreenUpdating = False

Application.EnableCancelKey = xlDisabled

Workbooks.Add
Sheets(2).Delete
Sheets(2).Delete
Range("A1").Value = "Zip File Name"
Range("B1").Value = "Sub Folder"
Range("C1").Value = "File Name"
Range("D1").Value = "File Size"

i = 2

mypath = GetFolderName("Select Folder where Data Files are stored")

If mypath = "" Then
Exit Sub
End If
'Fcount = CountFiles(mypath, "txt")

If Right(mypath, 1) <> "\" Then
mypath = mypath & "\"
End If

FName = Dir(mypath)

Do While FName <> ""

If UCase(FName) Like "*.ZIP" Then
Fname2 = ""
Call ListZip(mypath & FName)
End If

FName = Dir
Loop
Range("A:D").EntireColumn.AutoFit
Range("A2").Select
ActiveWindow.FreezePanes = True
End Sub
Public Sub ListZip(SrcFile)
Set oApp = CreateObject("Shell.Application")

For Each fileNameInZip In oApp.Namespace(SrcFile).Items
If fileNameInZip.IsFolder = True Then 'Or Right(fileNameInZip, 3) = "zip" Then
If Fname2 = "" Then
Fname2 = fileNameInZip
Else
Fname2 = Fname2 & "\" & fileNameInZip
End If

Call ListZip(fileNameInZip)
Else
Range("A" & i).Value = FName
Range("B" & i).Value = Fname2
Range("C" & i).Value = fileNameInZip
Range("D" & i).Value = fileNameInZip.Size
i = i + 1
End If
Next
If Fname2 <> "" Then
Fname2 = Left(Fname2, Len(Fname2) - Len(SrcFile))
If Right(Fname2, 1) = "\" Then
Fname2 = Left(Fname2, Len(Fname2) - 1)
End If

End If
Set oApp = Nothing
End Sub