ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Worksheet Functions (https://www.excelbanter.com/excel-worksheet-functions/)
-   -   macro to list folders only, not files (https://www.excelbanter.com/excel-worksheet-functions/226555-macro-list-folders-only-not-files.html)

jat
macro to list folders only, not files
 
i have the following macro (findfile) from this site:

Sub findfile()

'directory to start searching
strFolder = "D:\Operations\Human Resources"

RowCount = 1
Do
Mode = InputBox("What type of search do you want to perform?" & vbCrLf & _
"1: list of folders only" & vbCrLf & _
"2: list of files only" & vbCrLf & _
"3: list of files and folders only")
Loop While Mode < 1 Or Mode 3

If Mode = 2 Or Mode = 3 Then
Addlinks = MsgBox("Do you want to include Hyperlinks?", vbYesNo, _
Title:=Hyperlinks)
Else
Hyperlinks = vbNo
End If


Set fso = CreateObject _
("Scripting.FileSystemObject")
Set folder = _
fso.GetFolder(strFolder)

Call GetWorksheetsSubFolder(strFolder + "\", Mode, Addlinks, RowCount)

End Sub

Sub GetWorksheetsSubFolder(strFolder, Mode, Addlinks, ByRef RowCount)
Set fso = CreateObject _
("Scripting.FileSystemObject")

Set folder = _
fso.GetFolder(strFolder)
If Mode = 1 Or Mode = 3 Then
Range("A" & RowCount) = strFolder
RowCount = RowCount + 1
End If

If folder.subfolders.Count 0 Then
For Each sf In folder.subfolders
On Error GoTo 100
Call GetWorksheetsSubFolder(strFolder + sf.Name + "\", Mode,
Addlinks, RowCount)
100 Next sf
End If
'folder size in bytes
On Error GoTo 200
If Mode = 2 Or Mode = 3 Then
For Each fl In folder.Files
If Addlinks = vbYes Then
With ActiveSheet
.Hyperlinks.Add Anchor:=.Range("A" & RowCount),
Address:=fl.Path, TextToDisplay:=fl.Path
End With
Else
Range("A" & RowCount) = fl
End If
RowCount = RowCount + 1
Next fl
End If
200 On Error GoTo 0

End Sub


the macro works as intended, but i do not want the extra options (user
enters 1, 2 or 3) and when the list is populated, it shows the full directory
path (not wanted) and also has "\" at the end. all i want is the folder name
to be populated in the list.

because the form that i make will be used on other computers also, i do not
want to use an addin, but a code.

any help would be appreciated.

jat

Jacob Skaria
macro to list folders only, not files
 
Will this help..Specify the path name

Sub ListFolders()

intRow = 1
strPath = "c:\"
strFName = Dir(strPath, vbDirectory)
Do While strFName < ""
If (GetAttr(strPath & strFName) And vbDirectory) = vbDirectory Then
Range("A" & intRow) = strFName
intRow = intRow + 1
End If
strFName = Dir()
Loop

End Sub

If this post helps click Yes
---------------
Jacob Skaria


"jat" wrote:

i have the following macro (findfile) from this site:

Sub findfile()

'directory to start searching
strFolder = "D:\Operations\Human Resources"

RowCount = 1
Do
Mode = InputBox("What type of search do you want to perform?" & vbCrLf & _
"1: list of folders only" & vbCrLf & _
"2: list of files only" & vbCrLf & _
"3: list of files and folders only")
Loop While Mode < 1 Or Mode 3

If Mode = 2 Or Mode = 3 Then
Addlinks = MsgBox("Do you want to include Hyperlinks?", vbYesNo, _
Title:=Hyperlinks)
Else
Hyperlinks = vbNo
End If


Set fso = CreateObject _
("Scripting.FileSystemObject")
Set folder = _
fso.GetFolder(strFolder)

Call GetWorksheetsSubFolder(strFolder + "\", Mode, Addlinks, RowCount)

End Sub

Sub GetWorksheetsSubFolder(strFolder, Mode, Addlinks, ByRef RowCount)
Set fso = CreateObject _
("Scripting.FileSystemObject")

Set folder = _
fso.GetFolder(strFolder)
If Mode = 1 Or Mode = 3 Then
Range("A" & RowCount) = strFolder
RowCount = RowCount + 1
End If

If folder.subfolders.Count 0 Then
For Each sf In folder.subfolders
On Error GoTo 100
Call GetWorksheetsSubFolder(strFolder + sf.Name + "\", Mode,
Addlinks, RowCount)
100 Next sf
End If
'folder size in bytes
On Error GoTo 200
If Mode = 2 Or Mode = 3 Then
For Each fl In folder.Files
If Addlinks = vbYes Then
With ActiveSheet
.Hyperlinks.Add Anchor:=.Range("A" & RowCount),
Address:=fl.Path, TextToDisplay:=fl.Path
End With
Else
Range("A" & RowCount) = fl
End If
RowCount = RowCount + 1
Next fl
End If
200 On Error GoTo 0

End Sub


the macro works as intended, but i do not want the extra options (user
enters 1, 2 or 3) and when the list is populated, it shows the full directory
path (not wanted) and also has "\" at the end. all i want is the folder name
to be populated in the list.

because the form that i make will be used on other computers also, i do not
want to use an addin, but a code.

any help would be appreciated.

jat

joel
macro to list folders only, not files
 
You have one of my programs. jat soltiion will work if you just want the
folders in the roots directory. It will not find subfolders. I modified the
code you posted to include your requested changes. Do you want the
hyperlinks for the folders? this code didn't provied the links and will
require a simple modification.

Sub findfile()

'directory to start searching
'strFolder = "D.:\Operations\Human Resources"
strFolder = "C:\Temp"

RowCount = 1
'
' Mode = InputBox("What type of search do you want to perform?" & vbCrLf & _
' "1: list of folders only" & vbCrLf & _
' "2: list of files only" & vbCrLf & _
' "3: list of files and folders only")
' Loop While Mode < 1 Or Mode 3
Mode = 1

'If Mode = 2 Or Mode = 3 Then
' Addlinks = MsgBox("Do you want to include Hyperlinks?", vbYesNo, _
' Title:=Hyperlinks)
'Else
' Hyperlinks = vbNo
'End If
Hyperlinks = vbNo

Set fso = CreateObject _
("Scripting.FileSystemObject")
Set folder = _
fso.GetFolder(strFolder)

Call GetWorksheetsSubFolder(strFolder + "\", Mode, Addlinks, RowCount)

End Sub

Sub GetWorksheetsSubFolder(strFolder, Mode, Addlinks, ByRef RowCount)
Set fso = CreateObject _
("Scripting.FileSystemObject")

Set folder = _
fso.GetFolder(strFolder)
If Mode = 1 Or Mode = 3 Then
Range("A" & RowCount) = Left(strFolder, Len(strFolder) - 1)
RowCount = RowCount + 1
End If

If folder.subfolders.Count 0 Then
For Each sf In folder.subfolders
On Error GoTo 100
Call GetWorksheetsSubFolder(strFolder + sf.Name + "\", _
Mode, Addlinks, RowCount)
100 Next sf
End If
'folder size in bytes
On Error GoTo 200
If Mode = 2 Or Mode = 3 Then
For Each fl In folder.Files
If Addlinks = vbYes Then
With ActiveSheet
.Hyperlinks.Add Anchor:=.Range("A" & RowCount), _
Address:=fl.Path, _
TextToDisplay:=fl.Path
End With
Else
Range("A" & RowCount) = fl
End If
RowCount = RowCount + 1
Next fl
End If
200 On Error GoTo 0

End Sub




"Jacob Skaria" wrote:

Will this help..Specify the path name

Sub ListFolders()

intRow = 1
strPath = "c:\"
strFName = Dir(strPath, vbDirectory)
Do While strFName < ""
If (GetAttr(strPath & strFName) And vbDirectory) = vbDirectory Then
Range("A" & intRow) = strFName
intRow = intRow + 1
End If
strFName = Dir()
Loop

End Sub

If this post helps click Yes
---------------
Jacob Skaria


"jat" wrote:

i have the following macro (findfile) from this site:

Sub findfile()

'directory to start searching
strFolder = "D:\Operations\Human Resources"

RowCount = 1
Do
Mode = InputBox("What type of search do you want to perform?" & vbCrLf & _
"1: list of folders only" & vbCrLf & _
"2: list of files only" & vbCrLf & _
"3: list of files and folders only")
Loop While Mode < 1 Or Mode 3

If Mode = 2 Or Mode = 3 Then
Addlinks = MsgBox("Do you want to include Hyperlinks?", vbYesNo, _
Title:=Hyperlinks)
Else
Hyperlinks = vbNo
End If


Set fso = CreateObject _
("Scripting.FileSystemObject")
Set folder = _
fso.GetFolder(strFolder)

Call GetWorksheetsSubFolder(strFolder + "\", Mode, Addlinks, RowCount)

End Sub

Sub GetWorksheetsSubFolder(strFolder, Mode, Addlinks, ByRef RowCount)
Set fso = CreateObject _
("Scripting.FileSystemObject")

Set folder = _
fso.GetFolder(strFolder)
If Mode = 1 Or Mode = 3 Then
Range("A" & RowCount) = strFolder
RowCount = RowCount + 1
End If

If folder.subfolders.Count 0 Then
For Each sf In folder.subfolders
On Error GoTo 100
Call GetWorksheetsSubFolder(strFolder + sf.Name + "\", Mode,
Addlinks, RowCount)
100 Next sf
End If
'folder size in bytes
On Error GoTo 200
If Mode = 2 Or Mode = 3 Then
For Each fl In folder.Files
If Addlinks = vbYes Then
With ActiveSheet
.Hyperlinks.Add Anchor:=.Range("A" & RowCount),
Address:=fl.Path, TextToDisplay:=fl.Path
End With
Else
Range("A" & RowCount) = fl
End If
RowCount = RowCount + 1
Next fl
End If
200 On Error GoTo 0

End Sub


the macro works as intended, but i do not want the extra options (user
enters 1, 2 or 3) and when the list is populated, it shows the full directory
path (not wanted) and also has "\" at the end. all i want is the folder name
to be populated in the list.

because the form that i make will be used on other computers also, i do not
want to use an addin, but a code.

any help would be appreciated.

jat

Jacob Skaria
macro to list folders only, not files
 
Hi Joel, I have not included the subfolders because in the initial request it
has been mentioned that "full directory path (not wanted) " without which
there is no point of having the subfolder name. Cheers........

If this post helps click Yes
---------------
Jacob Skaria


"joel" wrote:

You have one of my programs. jat soltiion will work if you just want the
folders in the roots directory. It will not find subfolders. I modified the
code you posted to include your requested changes. Do you want the
hyperlinks for the folders? this code didn't provied the links and will
require a simple modification.

Sub findfile()

'directory to start searching
'strFolder = "D.:\Operations\Human Resources"
strFolder = "C:\Temp"

RowCount = 1
'
' Mode = InputBox("What type of search do you want to perform?" & vbCrLf & _
' "1: list of folders only" & vbCrLf & _
' "2: list of files only" & vbCrLf & _
' "3: list of files and folders only")
' Loop While Mode < 1 Or Mode 3
Mode = 1

'If Mode = 2 Or Mode = 3 Then
' Addlinks = MsgBox("Do you want to include Hyperlinks?", vbYesNo, _
' Title:=Hyperlinks)
'Else
' Hyperlinks = vbNo
'End If
Hyperlinks = vbNo

Set fso = CreateObject _
("Scripting.FileSystemObject")
Set folder = _
fso.GetFolder(strFolder)

Call GetWorksheetsSubFolder(strFolder + "\", Mode, Addlinks, RowCount)

End Sub

Sub GetWorksheetsSubFolder(strFolder, Mode, Addlinks, ByRef RowCount)
Set fso = CreateObject _
("Scripting.FileSystemObject")

Set folder = _
fso.GetFolder(strFolder)
If Mode = 1 Or Mode = 3 Then
Range("A" & RowCount) = Left(strFolder, Len(strFolder) - 1)
RowCount = RowCount + 1
End If

If folder.subfolders.Count 0 Then
For Each sf In folder.subfolders
On Error GoTo 100
Call GetWorksheetsSubFolder(strFolder + sf.Name + "\", _
Mode, Addlinks, RowCount)
100 Next sf
End If
'folder size in bytes
On Error GoTo 200
If Mode = 2 Or Mode = 3 Then
For Each fl In folder.Files
If Addlinks = vbYes Then
With ActiveSheet
.Hyperlinks.Add Anchor:=.Range("A" & RowCount), _
Address:=fl.Path, _
TextToDisplay:=fl.Path
End With
Else
Range("A" & RowCount) = fl
End If
RowCount = RowCount + 1
Next fl
End If
200 On Error GoTo 0

End Sub




"Jacob Skaria" wrote:

Will this help..Specify the path name

Sub ListFolders()

intRow = 1
strPath = "c:\"
strFName = Dir(strPath, vbDirectory)
Do While strFName < ""
If (GetAttr(strPath & strFName) And vbDirectory) = vbDirectory Then
Range("A" & intRow) = strFName
intRow = intRow + 1
End If
strFName = Dir()
Loop

End Sub

If this post helps click Yes
---------------
Jacob Skaria


"jat" wrote:

i have the following macro (findfile) from this site:

Sub findfile()

'directory to start searching
strFolder = "D:\Operations\Human Resources"

RowCount = 1
Do
Mode = InputBox("What type of search do you want to perform?" & vbCrLf & _
"1: list of folders only" & vbCrLf & _
"2: list of files only" & vbCrLf & _
"3: list of files and folders only")
Loop While Mode < 1 Or Mode 3

If Mode = 2 Or Mode = 3 Then
Addlinks = MsgBox("Do you want to include Hyperlinks?", vbYesNo, _
Title:=Hyperlinks)
Else
Hyperlinks = vbNo
End If


Set fso = CreateObject _
("Scripting.FileSystemObject")
Set folder = _
fso.GetFolder(strFolder)

Call GetWorksheetsSubFolder(strFolder + "\", Mode, Addlinks, RowCount)

End Sub

Sub GetWorksheetsSubFolder(strFolder, Mode, Addlinks, ByRef RowCount)
Set fso = CreateObject _
("Scripting.FileSystemObject")

Set folder = _
fso.GetFolder(strFolder)
If Mode = 1 Or Mode = 3 Then
Range("A" & RowCount) = strFolder
RowCount = RowCount + 1
End If

If folder.subfolders.Count 0 Then
For Each sf In folder.subfolders
On Error GoTo 100
Call GetWorksheetsSubFolder(strFolder + sf.Name + "\", Mode,
Addlinks, RowCount)
100 Next sf
End If
'folder size in bytes
On Error GoTo 200
If Mode = 2 Or Mode = 3 Then
For Each fl In folder.Files
If Addlinks = vbYes Then
With ActiveSheet
.Hyperlinks.Add Anchor:=.Range("A" & RowCount),
Address:=fl.Path, TextToDisplay:=fl.Path
End With
Else
Range("A" & RowCount) = fl
End If
RowCount = RowCount + 1
Next fl
End If
200 On Error GoTo 0

End Sub


the macro works as intended, but i do not want the extra options (user
enters 1, 2 or 3) and when the list is populated, it shows the full directory
path (not wanted) and also has "\" at the end. all i want is the folder name
to be populated in the list.

because the form that i make will be used on other computers also, i do not
want to use an addin, but a code.

any help would be appreciated.

jat

joel
macro to list folders only, not files
 
The question is if they want the hyperlinks. You can display the folder name
without the path and still have the full path in the link.

"Jacob Skaria" wrote:

Hi Joel, I have not included the subfolders because in the initial request it
has been mentioned that "full directory path (not wanted) " without which
there is no point of having the subfolder name. Cheers........

If this post helps click Yes
---------------
Jacob Skaria


"joel" wrote:

You have one of my programs. jat soltiion will work if you just want the
folders in the roots directory. It will not find subfolders. I modified the
code you posted to include your requested changes. Do you want the
hyperlinks for the folders? this code didn't provied the links and will
require a simple modification.

Sub findfile()

'directory to start searching
'strFolder = "D.:\Operations\Human Resources"
strFolder = "C:\Temp"

RowCount = 1
'
' Mode = InputBox("What type of search do you want to perform?" & vbCrLf & _
' "1: list of folders only" & vbCrLf & _
' "2: list of files only" & vbCrLf & _
' "3: list of files and folders only")
' Loop While Mode < 1 Or Mode 3
Mode = 1

'If Mode = 2 Or Mode = 3 Then
' Addlinks = MsgBox("Do you want to include Hyperlinks?", vbYesNo, _
' Title:=Hyperlinks)
'Else
' Hyperlinks = vbNo
'End If
Hyperlinks = vbNo

Set fso = CreateObject _
("Scripting.FileSystemObject")
Set folder = _
fso.GetFolder(strFolder)

Call GetWorksheetsSubFolder(strFolder + "\", Mode, Addlinks, RowCount)

End Sub

Sub GetWorksheetsSubFolder(strFolder, Mode, Addlinks, ByRef RowCount)
Set fso = CreateObject _
("Scripting.FileSystemObject")

Set folder = _
fso.GetFolder(strFolder)
If Mode = 1 Or Mode = 3 Then
Range("A" & RowCount) = Left(strFolder, Len(strFolder) - 1)
RowCount = RowCount + 1
End If

If folder.subfolders.Count 0 Then
For Each sf In folder.subfolders
On Error GoTo 100
Call GetWorksheetsSubFolder(strFolder + sf.Name + "\", _
Mode, Addlinks, RowCount)
100 Next sf
End If
'folder size in bytes
On Error GoTo 200
If Mode = 2 Or Mode = 3 Then
For Each fl In folder.Files
If Addlinks = vbYes Then
With ActiveSheet
.Hyperlinks.Add Anchor:=.Range("A" & RowCount), _
Address:=fl.Path, _
TextToDisplay:=fl.Path
End With
Else
Range("A" & RowCount) = fl
End If
RowCount = RowCount + 1
Next fl
End If
200 On Error GoTo 0

End Sub




"Jacob Skaria" wrote:

Will this help..Specify the path name

Sub ListFolders()

intRow = 1
strPath = "c:\"
strFName = Dir(strPath, vbDirectory)
Do While strFName < ""
If (GetAttr(strPath & strFName) And vbDirectory) = vbDirectory Then
Range("A" & intRow) = strFName
intRow = intRow + 1
End If
strFName = Dir()
Loop

End Sub

If this post helps click Yes
---------------
Jacob Skaria


"jat" wrote:

i have the following macro (findfile) from this site:

Sub findfile()

'directory to start searching
strFolder = "D:\Operations\Human Resources"

RowCount = 1
Do
Mode = InputBox("What type of search do you want to perform?" & vbCrLf & _
"1: list of folders only" & vbCrLf & _
"2: list of files only" & vbCrLf & _
"3: list of files and folders only")
Loop While Mode < 1 Or Mode 3

If Mode = 2 Or Mode = 3 Then
Addlinks = MsgBox("Do you want to include Hyperlinks?", vbYesNo, _
Title:=Hyperlinks)
Else
Hyperlinks = vbNo
End If


Set fso = CreateObject _
("Scripting.FileSystemObject")
Set folder = _
fso.GetFolder(strFolder)

Call GetWorksheetsSubFolder(strFolder + "\", Mode, Addlinks, RowCount)

End Sub

Sub GetWorksheetsSubFolder(strFolder, Mode, Addlinks, ByRef RowCount)
Set fso = CreateObject _
("Scripting.FileSystemObject")

Set folder = _
fso.GetFolder(strFolder)
If Mode = 1 Or Mode = 3 Then
Range("A" & RowCount) = strFolder
RowCount = RowCount + 1
End If

If folder.subfolders.Count 0 Then
For Each sf In folder.subfolders
On Error GoTo 100
Call GetWorksheetsSubFolder(strFolder + sf.Name + "\", Mode,
Addlinks, RowCount)
100 Next sf
End If
'folder size in bytes
On Error GoTo 200
If Mode = 2 Or Mode = 3 Then
For Each fl In folder.Files
If Addlinks = vbYes Then
With ActiveSheet
.Hyperlinks.Add Anchor:=.Range("A" & RowCount),
Address:=fl.Path, TextToDisplay:=fl.Path
End With
Else
Range("A" & RowCount) = fl
End If
RowCount = RowCount + 1
Next fl
End If
200 On Error GoTo 0

End Sub


the macro works as intended, but i do not want the extra options (user
enters 1, 2 or 3) and when the list is populated, it shows the full directory
path (not wanted) and also has "\" at the end. all i want is the folder name
to be populated in the list.

because the form that i make will be used on other computers also, i do not
want to use an addin, but a code.

any help would be appreciated.

jat


All times are GMT +1. The time now is 03:29 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com