Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.worksheet.functions
|
|||
|
|||
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 |
#2
Posted to microsoft.public.excel.worksheet.functions
|
|||
|
|||
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 |
#3
Posted to microsoft.public.excel.worksheet.functions
|
|||
|
|||
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 |
#4
Posted to microsoft.public.excel.worksheet.functions
|
|||
|
|||
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 |
#5
Posted to microsoft.public.excel.worksheet.functions
|
|||
|
|||
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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
.tmp files filling up my folders | Excel Discussion (Misc queries) | |||
.TMP files are corrupting my folders | Excel Discussion (Misc queries) | |||
Can anyone help me Create Excel list of files in windows folders | Excel Worksheet Functions | |||
links to same files in different folders | Excel Worksheet Functions | |||
Opening Files/Folders | Excel Discussion (Misc queries) |