Hi Pavan It is working fine with me Rajan.
-----Original Message----- From: excel-macros@googlegroups.com [mailto:excel-macros@googlegroups.com] On Behalf Of pavan Kumar Sent: Apr/Thu/2012 06:33 To: excel-macros Subject: Re: $$Excel-Macros$$ Re: Folder Structure - VBA Code 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 -- 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
