HI,
I was able to find the VBA code for the zip file, but its not looping
till the last content, please help on this, the code has been pasted
below for your reference
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
On 4/19/12, pavan Kumar <pavanshr...@gmail.com> wrote:
> HI Team,
>
> Any update on the Zip files structure ?
>
> Regards,
> Pavan Kumar G
>
> On 4/16/12, pavan Kumar <pavanshr...@gmail.com> wrote:
>> HI Group,
>>
>> I am looking for a VBA code to get the Folder Structure, name and type
>> (the code also needs to get the folder structure of Zip files too)
>>
>>
>> Exmpl:
>>
>> C:\OLD\Main\
>> C:\OLD\Main\SF1\
>> C:\OLD\Main\SF1\
>> C:\OLD\Main\SF1\
>> C:\OLD\Main\SF1\SF2\
>> C:\OLD\Main\SF1\SF2\
>> C:\OLD\Main\SF1\SF2\SF3\
>> C:\OLD\Main\SF1\SF2\SF3\
>> C:\OLD\Main\SF1\SF2\SF3\SF4\
>> C:\OLD\Main\SF1\SF2\SF3\SF4\
>>
>>
>> Regards,
>>
>> Pavan kumar G
>>
>
> --
> FORUM RULES (986+ members already BANNED for violation)
>
> 1) Use concise, accurate thread titles. Poor thread titles, like Please
> Help, Urgent, Need Help, Formula Problem, Code Problem, and Need Advice will
> not get quick attention or may not be answered.
>
> 2) Don't post a question in the thread of another member.
>
> 3) Don't post questions regarding breaking or bypassing any security
> measure.
>
> 4) Acknowledge the responses you receive, good or bad.
>
> 5) Cross-promotion of, or links to, forums competitive to this forum in
> signatures are prohibited.
>
> NOTE : Don't ever post personal or confidential data in a workbook. Forum
> owners and members are not responsible for any loss.
>
> ------------------------------------------------------------------------------------------------------
> To post to this group, send email to excel-macros@googlegroups.com
>
--
FORUM RULES (986+ members already BANNED for violation)
1) Use concise, accurate thread titles. Poor thread titles, like Please Help,
Urgent, Need Help, Formula Problem, Code Problem, and Need Advice will not get
quick attention or may not be answered.
2) Don't post a question in the thread of another member.
3) Don't post questions regarding breaking or bypassing any security measure.
4) Acknowledge the responses you receive, good or bad.
5) Cross-promotion of, or links to, forums competitive to this forum in
signatures are prohibited.
NOTE : Don't ever post personal or confidential data in a workbook. Forum
owners and members are not responsible for any loss.
------------------------------------------------------------------------------------------------------
To post to this group, send email to excel-macros@googlegroups.com
