What VBA did you write yourself ?
Hi,
Can someone help write a macro that will list in column 1 all the sub-folders that have a name that start with 4500 or 4600. e.g. if a folder starts with 4600 you may have sub-folders that have a name that starts with 4500 and if the found folder name starts with 4500 then list it in column A and look for the next folder at the same level.
example:
C:\sample1
C:\Sample1\4600xxxx
C:\Sample1\4600xxxx\4500xxxx
C:\Sample1\4600xxxx\4500xxxx
C:\Sample1\4600xxxx\4500xxxx
C:\Sample2
C:\Sample2\4500xxxx
C:|Sample2\4500xxxx
So the objective is to list all those folders that have as either 4600xxxx or 4500xxxx
I look forward to your help.
Regards,
Chuck
What VBA did you write yourself ?
Hi Snb
I got this macro from one of the forum, I can't remember which one but it lists all the Folders and Sub-folders in column 1 but my objective is to select only the ones as listed in my prior question and list in column 1 only the part which name is 4600xxxx or 4500xxxx where xxxx can change in column 1 (A) I want to show the 4600xxxx and in column 2 (B) the 4500xxx. I could not figure out how to do that I am a newbie in vba.
This is how it should look like:
4600xxxx
4500xxxx
4500xxx2
4500xxx3
here below is the macro I got from one forum:
HTML Code:'Looping Through Folders and Files in VBA Public ObjFolder As Object Public objFso As Object Public objFldLoop As Object Public lngCounter As Long Public objFl As Object '=================================================================== 'A procedure to call the Function LoopThroughEachFolder(objFolder) '=================================================================== Sub GetFolderStructure() ' lngCounter = 0 Set objFso = CreateObject("Scripting.FileSystemObject") With Application.FileDialog(msoFileDialogFolderPicker) .Show Set ObjFolder = objFso.GetFolder(.SelectedItems(1)) End With Range("A1").Offset(lngCounter).Value = ObjFolder.Path LoopThroughEachFolder ObjFolder End Sub '=================================================== 'Function to Loop through each Sub Folders '=================================================== Function LoopThroughEachFolder(fldFolder As Object) For Each objFldLoop In fldFolder.subFolders lngCounter = lngCounter + 1 Range("A1").Offset(lngCounter).Value = objFldLoop.Path LoopThroughEachFolder objFldLoop Next End Function
I finally made to work but still need few tune up to look as I wish. Here is the macro:
Hope this will help others too.HTML Code:'Looping Through Folders and Files in VBA Public ObjFolder As Object Public objFso As Object Public objFldLoop As Object Public lngCounter As Long Public objFl As Object '=================================================================== 'A procedure to call the Function LoopThroughEachFolder(objFolder) '=================================================================== Sub GetFolderStructure() ' lngCounter = 0 Set objFso = CreateObject("Scripting.FileSystemObject") With Application.FileDialog(msoFileDialogFolderPicker) .Show Set ObjFolder = objFso.GetFolder(.SelectedItems(1)) End With Range("A1").Offset(lngCounter).Value = ObjFolder.Path LoopThroughEachFolder ObjFolder End Sub '=================================================== 'Function to Loop through each Sub Folders '=================================================== Function LoopThroughEachFolder(fldFolder As Object) Dim P As Long For Each objFldLoop In fldFolder.subFolders lngCounter = lngCounter + 1 P = InStr(1, objFldLoop.Path, "4600") If P <> 0 Then Range("A1").Offset(lngCounter).Value = Mid(objFldLoop.Path, P, 10) Else P = InStr(1, objFldLoop.Path, "4500") If P <> 0 Then Range("A1").Offset(lngCounter).Value = Mid(objFldLoop.Path, P, 10) End If End If LoopThroughEachFolder objFldLoop Next End Function
Cheers!
Chuck
Bookmarks