Home |
Search |
Today's Posts |
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
Hello all,
I created a module that looks for files and then lists the file with the full path name in Column A and then it lists just the file name in Column B. It works well as this was just me learning VBA a bit more. I am sure it is clunky and would love it if you guru's out there could look it over and send me your thoughts and if there is a much more efficient way please let me know so I can compare mine versus the efficient one and use that as a learning tool some more. Code is listed below, I look forward to hearing from you. P.S. I have not done any error trapping so if you leave the input box blank, it messes up but I will get to that part as well. I used *.xls as my criteria since I am working with Excel. Sub Dirtree() Dim RC As Integer Dim CC As Integer RC = 1 Dim pos As Long Dim cell As Range Dim R1 As Range Dim R2 As Range Dim ExName As String Worksheets(1).Range("A:B").Select Selection.Delete Set fs = Application.FileSearch With fs .NewSearch .LookIn = "C:\" .SearchSubFolders = True .FILENAME = InputBox("Enter File type you are looking for, using the *.extension format", "Filesearch") .MatchTextExactly = True .FileType = msoFileTypeAllFiles If .Execute() 0 Then For i = 1 To .FoundFiles.Count Worksheets(1).Cells(RC, 1) = .FoundFiles(i) RC = RC + 1 Next i Else MsgBox "There were no files found." End If End With Worksheets(1).Range("A:A").Copy ActiveSheet.paste Destination:=Worksheets(1).Range("B:B") Worksheets(1).Range("B:B").Select For Each cell In Selection pos = InStrRev(cell.Value, "\") If pos 0 Then cell.Value = Right(cell.Value, Len(cell.Value) - pos) End If Next cell Worksheets(1).Range("A:B").Sort _ Key1:=Worksheets(1).Range("B1") End Sub TIA Wally Steadman -- Walter Steadman CW2, USA 124th Signal Battalion Network Management Tech |
#2
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
It might not be fast, but other than that the only improvements would be at
the margins. One of the more inefficient interfaces (from a performance perspective) is the VBA-XL one. You can dramatically speeden up your code by restricting the number of worksheet updates. Use something like: Option Explicit Function NameOnly(fName As String) Dim Pos As Integer Pos = InStrRev(fName, "\") If Pos 0 Then NameOnly = Right(fName, Len(fName) - Pos) Else NameOnly = fName End If End Function Sub Dirtree() Dim FS As FileSearch, I As Long, Rslt() As String Worksheets(1).Range("A:B").Delete Set FS = Application.FileSearch With FS .NewSearch .LookIn = "c:\" .SearchSubFolders = True .Filename = InputBox( _ "Enter File type you are looking for, using the *.extension format", "Filesearch") .MatchTextExactly = True .FileType = msoFileTypeAllFiles If .Execute() 0 Then ReDim Rslt(1 To .FoundFiles.Count, 1 To 2) For I = 1 To .FoundFiles.Count Rslt(I, 1) = .FoundFiles(I) Rslt(I, 2) = NameOnly(Rslt(I, 1)) Next I Else MsgBox "There were no files found." End If End With Worksheets(1).Range("a1").Resize(UBound(Rslt, 1), 2).Value = Rslt Worksheets(1).Range("A:B").Sort _ Key1:=Worksheets(1).Range("B1") End Sub The above ignores various safety concerns (one you have noted as well as others such as too many files) as well as anecdotal comments from various people about problems with FileSearch. For a ready made solution, check Directory List http://www.tushar-mehta.com/excel/so...ist/index.html "Wally Steadman" wrote: Hello all, I created a module that looks for files and then lists the file with the full path name in Column A and then it lists just the file name in Column B. It works well as this was just me learning VBA a bit more. I am sure it is clunky and would love it if you guru's out there could look it over and send me your thoughts and if there is a much more efficient way please let me know so I can compare mine versus the efficient one and use that as a learning tool some more. Code is listed below, I look forward to hearing from you. P.S. I have not done any error trapping so if you leave the input box blank, it messes up but I will get to that part as well. I used *.xls as my criteria since I am working with Excel. Sub Dirtree() Dim RC As Integer Dim CC As Integer RC = 1 Dim pos As Long Dim cell As Range Dim R1 As Range Dim R2 As Range Dim ExName As String Worksheets(1).Range("A:B").Select Selection.Delete Set fs = Application.FileSearch With fs .NewSearch .LookIn = "C:\" .SearchSubFolders = True .FILENAME = InputBox("Enter File type you are looking for, using the *.extension format", "Filesearch") .MatchTextExactly = True .FileType = msoFileTypeAllFiles If .Execute() 0 Then For i = 1 To .FoundFiles.Count Worksheets(1).Cells(RC, 1) = .FoundFiles(i) RC = RC + 1 Next i Else MsgBox "There were no files found." End If End With Worksheets(1).Range("A:A").Copy ActiveSheet.paste Destination:=Worksheets(1).Range("B:B") Worksheets(1).Range("B:B").Select For Each cell In Selection pos = InStrRev(cell.Value, "\") If pos 0 Then cell.Value = Right(cell.Value, Len(cell.Value) - pos) End If Next cell Worksheets(1).Range("A:B").Sort _ Key1:=Worksheets(1).Range("B1") End Sub TIA Wally Steadman -- Walter Steadman CW2, USA 124th Signal Battalion Network Management Tech |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
Excel guru's help! | Excel Discussion (Misc queries) | |||
A ? for our Excel Guru's and MVPs | Excel Discussion (Misc queries) | |||
A ? for our Excel Guru's and MVPs | Excel Worksheet Functions | |||
For guru's: textbox printing problems | Excel Programming | |||
The For Loop Worked, but need critique | Excel Programming |