Get Sub Directories using VBA Dir Function
The below function is used to get the immediate sub-directories for a given directory. If you want to dig deep into the directory structure then you need to iterate the sub-directories as well
Sub Get_All_SubDirectories()
Dim arSubDir() As String
Dim sSubDir As String
sSubDir = GetSubDir("d:\trash\")
' -----------------------------------------------------------
' Coded by Shasur for http://vbadud.blogspot.com
' -----------------------------------------------------------
If LenB(sSubDir) <> 0 Then
arSubDir = Split(sSubDir, ";")
For i1 = 0 To UBound(arSubDir)
Debug.Print arSubDir(i1)
Next i1
End If
End Sub
Function GetSubDir(ByVal sPath As String, Optional ByVal sPattern As Variant) As Variant
Dim sDir As String
Dim sDirLocationForText As String
On Error GoTo Err_Clk
If Right$(sPath, 1) <> "\" Then sPath = sPath & "\"
If IsMissing(sPattern) Then
sDir = Dir$(sPath, vbDirectory)
Else
sDir = Dir$(sPath & sPattern, vbDirectory)
End If
' -----------------------------------------------------------
' Coded by Shasur for http://vbadud.blogspot.com
' -----------------------------------------------------------
Do Until LenB(sDir) = 0
' -----------------------------------------------------
' This will be the location for the sub directory
' -----------------------------------------------------
If sDir <> "." And sDir <> ".." Then
sDirLocationForText = sDirLocationForText & ";" & sPath & sDir
End If
sDir = Dir$
Loop
If Left$(sDirLocationForText, 1) = ";" Then sDirLocationForText = Right(sDirLocationForText, Len(sDirLocationForText) - 1)
GetSubDir = sDirLocationForText
Err_Clk:
If Err <> 0 Then
Err.Clear
Resume Next
End If
End Function
Sunday, May 27, 2007
Download Windows Live Toolbar and personalize your Web experience! Add custom buttons to get the information you care about most.
Posts
Please post code for updated method - recursive deep searching in directory until lowest level.
ReplyDeleteHi Anton
ReplyDeleteCan you please check if this post (http://vbadud.blogspot.com/2010/05/how-to-iterate-through-all.html) helps you
Thanks
this is not good idea. there may be many situation in which is windows installed on another partition, not C. simply modify of code will be enough.
ReplyDeleteHi My name is Hussain(patanwalahussain@gmail.com).
ReplyDeletei dont know any programming language.
I want similar codes like this.
requirements
1) It should work with excel 2007.
2) It should only list names with file extensions like ".pdf"
3)It should ask me location before actual macro runs.
4) It should also list all the file in desired path and also it should list all files in its sub directories
for e.g. desired location
\\calcrm\crmpdfs\ifc\2010\201008
sub-directories
batch0091
batch0092 and so on.
thanks in advance and request to send excel file without password protected to my email id patanwalahussain@gmail.com
Sub ShowFolderList()
ReplyDeleteDim fs, f, f1, fc, s, fr, r, D, WSN
Dim folderspec
Dim I As Integer
'Delete all the worksheets
Workbooks.Add
Application.ScreenUpdating = False
Application.DisplayAlerts = False
For I = ActiveWorkbook.Worksheets.Count To 1 Step -1
If Worksheets(I).Name <> "Sheet1" Then Worksheets(I).Delete
Next I
'Insert worksheet with folder name
folderspec = "D:\Dinakaran" 'CurDir()
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(folderspec)
Set fc = f.SubFolders
For Each f1 In fc
With ActiveWorkbook.Sheets.Add
ActiveSheet.Name = f1.Name
End With
Next
'Delete Sheet1
ActiveWorkbook.Sheets("Sheet1").Delete
Application.ScreenUpdating = True
Application.DisplayAlerts = True
'List all the files
For Each xlSheet In ActiveWorkbook.Worksheets
WSN = xlSheet.Name
D = "D:\Dinakaran\" & WSN & "\"
xlSheet.Cells(1, 1) = "Filenames"
r = 2
fr = Dir(D, 7)
Do While fr <> ""
xlSheet.Cells(r, 1) = fr
r = r + 1
fr = Dir
Loop
'r = 0
Next xlSheet
End Sub
It's perfect Anonymous.
ReplyDeleteBut if we have:
D:\Lucru
D:\Lucru\*.*
D:\Lucru\2010
D:\Lucru\2010\*.*
D:\Lucru\2010\12032011
D:\Lucru\2010\12032011\*.*
D:\Lucru\2010\12032012
D:\Lucru\2010\12032011\*.*
Thanks
For this scenario is it possible to go even deeper and search content?
ReplyDeleteWith the same method can I search even deeper for specific content?
ReplyDelete