Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
macro listing subfolders from selection of mainfolders
Hey Guys
I hope you will help me again :) I found this macro at Tom Ogilvys (thanks Tom). It generates a name-list of the subfolders in the one mainfolder c: \MyRoot\ My challenge is to make a analogous list of all the subfolders (only the 4 caractres to the left in the subfoldername) in a selection of mainfolders. The selection of mainfolder is based on the beginng of foldername: "H: \Order *\". H:\order 2004\ H:\order 2005\ H:\order 2006\ H:\order 2007\ and so on The final list will go like this: 0104 0204 ... 1504 0105 0205 0305 .... 9905 and so on. Sub ListSubs() Dim MyPath As String, MyName As String Dim rw As Long rw = 1 MyPath = "c:\MyRoot\" ' Set the path. MyName = Dir(MyPath, vbDirectory) ' Retrieve the first entry. Do While MyName < "" ' Start the loop. ' Ignore the current directory and the encompassing directory. If MyName < "." And MyName < ".." Then ' Use bitwise comparison to make sure MyName is a directory. If (GetAttr(MyPath & MyName) And vbDirectory) = vbDirectory Then Cells(rw, 1).Value = MyName ' Display entry only if it rw = rw + 1 ' represents a directory. End If End If MyName = Dir ' Get next entry. Loop End Sub Do anyone feel to guide me on this one? Best Regards Snoopy |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
macro listing subfolders from selection of mainfolders
On Dec 1, 6:18*am, Snoopy wrote:
Hey Guys I hope you will help me again :) I found this macro at Tom Ogilvys (thanks Tom). It generates a name-list of the subfolders in the one mainfolder c: \MyRoot\ My challenge is to make a analogous list of all the subfolders (only the 4 caractres to the left in the subfoldername) in a selection of mainfolders. The selection of mainfolder is based on the beginng of foldername: "H: \Order *\". H:\order 2004\ H:\order 2005\ H:\order 2006\ H:\order 2007\ *and so on The final list will go like this: 0104 0204 .. 1504 0105 0205 0305 ... 9905 and so on. Sub ListSubs() Dim MyPath As String, MyName As String Dim rw As Long rw = 1 MyPath = "c:\MyRoot\" ' Set the path. MyName = Dir(MyPath, vbDirectory) ' Retrieve the first entry. Do While MyName < "" ' Start the loop. *' Ignore the current directory and the encompassing directory. If MyName < "." And MyName < ".." Then * ' Use bitwise comparison to make sure MyName is a directory. * If (GetAttr(MyPath & MyName) And vbDirectory) = vbDirectory Then * *Cells(rw, 1).Value = MyName ' Display entry only if it * *rw = rw + 1 * * * * * * * ' *represents a directory. * End If *End If *MyName = Dir ' Get next entry. Loop End Sub Do anyone feel to guide me on this one? Best Regards Snoopy For some reason just passing the folder to a sub caused an error when I returned to the calling sub. So I wrote the folder names to column A and then read that column and wrote subfolder names in Column B. HTH Tom Dim rwP As Long Sub ListFolders() 'modified to write folders to column A Dim MyPath As String, MyName As String, FolderPrefix As String Dim rw As Long FolderPrefix = "Order" rwP = 1 rw = 1 MyPath = "F:\" ' Set the path. MyName = Dir(MyPath, vbDirectory) ' Retrieve the first entry. Do While MyName < "" ' Start the loop. ' Ignore the current directory and the encompassing directory. If MyName < "." And MyName < ".." Then ' Use bitwise comparison to make sure MyName is a directory. If (GetAttr(MyPath & MyName) And vbDirectory) = vbDirectory Then If Mid(MyName, 1, 5) = FolderPrefix Then 'Look for folders of the type wanted Cells(rw, 1).Value = MyPath & MyName & "\" rw = rw + 1 End If End If ' End If MyName = Dir ' Get next entry. Loop ListSubs2 End Sub Sub ListSubs2() ' Modified to read folders from column A and write subfolers to column B Dim MyPath As String, MyName As String Dim MyName2 As String Dim Myrow Dim rw As Long rwP = 1 If Cells(1, 1).CurrentRegion.Rows.Count = 1 Then If (Cells(1, 1).Value) = "" Then Exit Sub End If End If For Each Myrow In Cells(1, 1).CurrentRegion.Rows MyPath = Myrow.Cells(1, 1).Value MyName2 = Dir(MyPath, vbDirectory) ' Retrieve the first entry. Do While MyName2 < "" ' Start the loop. ' Ignore the current directory and the encompassing directory. If MyName2 < "." And MyName2 < ".." Then ' Use bitwise comparison to make sure MyName is a directory. If (GetAttr(MyPath & MyName2) And vbDirectory) = vbDirectory Then Cells(rwP, 2).Value = MyName2 ' Display entry only if it rwP = rwP + 1 ' represents a directory. End If End If MyName2 = Dir ' Get next entry. Loop Next End Sub |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Macro to Find File in Subfolders and Open it | Excel Programming | |||
run macro on all closed workbooks in folder and subfolders | Excel Programming | |||
SubFolders in macro | Excel Programming | |||
copy subfolders, replace text in files and save files in copied subfolders | Excel Programming | |||
Listing a selection of data from one worksheet on another | Excel Discussion (Misc queries) |