Home |
Search |
Today's Posts |
|
#1
![]()
Posted to microsoft.public.excel.worksheet.functions
|
|||
|
|||
![]()
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
|
|||
|
|||
![]()
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
|
|||
|
|||
![]()
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
|
|||
|
|||
![]()
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
|
|||
|
|||
![]()
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 | |
|
|
![]() |
||||
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) |