| Home | Forums | Reviews | Articles | Register |
![]() |
| Thread Tools | Rate Thread |
|
|
|
| |
|
=?Utf-8?B?SkxhdGhhbQ==?=
Guest
Posts: n/a
|
Sorry, I'm kind of an old fashioned type, so I didn't even mess with
..FileSearch and came up with this for you: Sub List_lst_Files() Const basicPath = "S:\GEOTESTS\shears\" Const listSheetName = "List of lst Files" Dim anyFileName As String Dim searchFor As String Dim rOffset As Long Dim listBaseCell As Range 'test for existing sheet named 'List of lst Files' On Error Resume Next Worksheets(listSheetName).Cells.Clear If Err <> 0 Then Err.Clear On Error GoTo 0 Worksheets.Add after:=Worksheets(Worksheets.Count) ActiveSheet.Name = listSheetName End If On Error GoTo 0 Set listBaseCell = Worksheets(listSheetName).Range("A1") 'build path/name that looks like 'S:\GEOTEST\shears\AAAA\G20@100*.lst" 'to use as mask for DIR$() function searchFor = basicPath & _ Worksheets("DEFAULTS").Range("C3").Value & "\" & _ Worksheets("DEFAULTS").Range("C5").Value & "@" & _ Worksheets("DEFAULTS").Range("C6").Value & "*.lst" anyFileName = Dir$(searchFor) Do While anyFileName <> "" listBaseCell.Offset(rOffset, 0) = anyFileName rOffset = rOffset + 1 anyFileName = Dir$ ' gets next match for original 'mask' Loop set listBaseCell = Nothing ' release resource End Sub "maperalia" wrote: > I wonder If somebody can help me with this matter. > I have a program that finds the “lst” files located under the directory > described on the cell”C3”. > However, when I call these files I got all the files located under this > directory where sometimes more than 1000 files are found under this > directory. The fact is that I just need three or four of them. > > I have been trying to make it run accordingly what I need (see macro below). > However, I could not make it work. I wonder if I can get just the files I > need. For example, if the cell “C3” has the description AAAA, cell “C5” has > the description G20, and the cell “C6” has the description 100. I want to > call the files under the directory AAAA which have the following files: > G20@100A > G20@100B > G20@100C > G20@100D > Sometimes, there are just three of them (A, B, and C) and sometimes are four > (A, B, C, and D). > Could you please check my program and let me know where I am failing because > I can not make it run. > > Thanks in advance. > Maperalia > > > > > > '*********************************************************************** > ‘Start Program > Sub List_lst_Files() > > Dim FName As String > Dim r As Integer > Dim i As Long > Dim MyPath As String > Dim WO As String > Dim EXCAVATION As String > Dim depth As String > Dim Filename As String > Dim PostLetter As String > > Const strFileType As String = "lst" '<<===== CHANGE > 'With ActiveSheet.Columns(1) > '.Hyperlinks.Delete > '.ClearContents > 'End With > > Application.ScreenUpdating = False > WO = Worksheets("DEFAULTS").Range("C3") > 'WO = Application.InputBox("Enter Work Order Number") > > > > EXCAVATION = Worksheets("DEFAULTS").Range("C5") > depth = Worksheets("DEFAULTS").Range("C6") > PostLetter = A,B,C,D > Filename = "" & EXCAVATION & "& ""@"" &" & depth & """PostLetter""" > MyPath = "S:\GEOTEST\shears\" & WO & "\" & Filename & ".lst" > > > > > On Error Resume Next > Worksheets("List of lst Files").Delete > On Error GoTo 0 > Application.DisplayAlerts = False > Worksheets.Add.Name = "List of lst Files" > > Application.ScreenUpdating = False > r = 2 > With Application.FileSearch > .NewSearch > .LookIn = MyPath > .SearchSubFolders = True > .Filename = "*." & strFileType > If .Execute() > 0 Then > For i = 1 To .FoundFiles.Count > FName = Mid(.FoundFiles(i), 1) > Cells(r, 1) = Mid(FName, Len(MyPath) + 1, 255) > > > > > Application.ScreenUpdating = False > r = r + 1 > Next i > End If > End With > > '************************************************************************************************* > 'FORMAT CELLS > Application.ScreenUpdating = False > ActiveSheet.Select > Columns("A:A").ColumnWidth = 20 > Columns("A:A").Select > With Selection > .HorizontalAlignment = xlCenter > .VerticalAlignment = xlBottom > .WrapText = False > .Orientation = 0 > .AddIndent = False > .IndentLevel = 0 > .ShrinkToFit = False > .ReadingOrder = xlContext > .MergeCells = False > End With > > > > Dim myCell As Range > Dim myStr As String > > Range("A1").Select > Set myCell = Worksheets("defaults").Range("C3") > > myStr = "=""LST Files Found Under ""&" & myCell.Address(external:=True) > & "&"" Directory""" > > ActiveCell.Formula = myStr > > End Sub > > ‘End Program > '*********************************************************************** > |
|
||
|
||||
|
=?Utf-8?B?bWFwZXJhbGlh?=
Guest
Posts: n/a
|
JLatham;
Thanks very much. It is working PERFECTLY!!!!! Maperalia "JLatham" wrote: > Sorry, I'm kind of an old fashioned type, so I didn't even mess with > .FileSearch and came up with this for you: > > Sub List_lst_Files() > Const basicPath = "S:\GEOTESTS\shears\" > Const listSheetName = "List of lst Files" > Dim anyFileName As String > Dim searchFor As String > Dim rOffset As Long > Dim listBaseCell As Range > > 'test for existing sheet named 'List of lst Files' > On Error Resume Next > Worksheets(listSheetName).Cells.Clear > If Err <> 0 Then > Err.Clear > On Error GoTo 0 > Worksheets.Add after:=Worksheets(Worksheets.Count) > ActiveSheet.Name = listSheetName > End If > On Error GoTo 0 > Set listBaseCell = Worksheets(listSheetName).Range("A1") > > 'build path/name that looks like > 'S:\GEOTEST\shears\AAAA\G20@100*.lst" > 'to use as mask for DIR$() function > searchFor = basicPath & _ > Worksheets("DEFAULTS").Range("C3").Value & "\" & _ > Worksheets("DEFAULTS").Range("C5").Value & "@" & _ > Worksheets("DEFAULTS").Range("C6").Value & "*.lst" > anyFileName = Dir$(searchFor) > Do While anyFileName <> "" > listBaseCell.Offset(rOffset, 0) = anyFileName > rOffset = rOffset + 1 > anyFileName = Dir$ ' gets next match for original 'mask' > Loop > set listBaseCell = Nothing ' release resource > End Sub > > > "maperalia" wrote: > > > I wonder If somebody can help me with this matter. > > I have a program that finds the “lst” files located under the directory > > described on the cell”C3”. > > However, when I call these files I got all the files located under this > > directory where sometimes more than 1000 files are found under this > > directory. The fact is that I just need three or four of them. > > > > I have been trying to make it run accordingly what I need (see macro below). > > However, I could not make it work. I wonder if I can get just the files I > > need. For example, if the cell “C3” has the description AAAA, cell “C5” has > > the description G20, and the cell “C6” has the description 100. I want to > > call the files under the directory AAAA which have the following files: > > G20@100A > > G20@100B > > G20@100C > > G20@100D > > Sometimes, there are just three of them (A, B, and C) and sometimes are four > > (A, B, C, and D). > > Could you please check my program and let me know where I am failing because > > I can not make it run. > > > > Thanks in advance. > > Maperalia > > > > > > > > > > > > '*********************************************************************** > > ‘Start Program > > Sub List_lst_Files() > > > > Dim FName As String > > Dim r As Integer > > Dim i As Long > > Dim MyPath As String > > Dim WO As String > > Dim EXCAVATION As String > > Dim depth As String > > Dim Filename As String > > Dim PostLetter As String > > > > Const strFileType As String = "lst" '<<===== CHANGE > > 'With ActiveSheet.Columns(1) > > '.Hyperlinks.Delete > > '.ClearContents > > 'End With > > > > Application.ScreenUpdating = False > > WO = Worksheets("DEFAULTS").Range("C3") > > 'WO = Application.InputBox("Enter Work Order Number") > > > > > > > > EXCAVATION = Worksheets("DEFAULTS").Range("C5") > > depth = Worksheets("DEFAULTS").Range("C6") > > PostLetter = A,B,C,D > > Filename = "" & EXCAVATION & "& ""@"" &" & depth & """PostLetter""" > > MyPath = "S:\GEOTEST\shears\" & WO & "\" & Filename & ".lst" > > > > > > > > > > On Error Resume Next > > Worksheets("List of lst Files").Delete > > On Error GoTo 0 > > Application.DisplayAlerts = False > > Worksheets.Add.Name = "List of lst Files" > > > > Application.ScreenUpdating = False > > r = 2 > > With Application.FileSearch > > .NewSearch > > .LookIn = MyPath > > .SearchSubFolders = True > > .Filename = "*." & strFileType > > If .Execute() > 0 Then > > For i = 1 To .FoundFiles.Count > > FName = Mid(.FoundFiles(i), 1) > > Cells(r, 1) = Mid(FName, Len(MyPath) + 1, 255) > > > > > > > > > > Application.ScreenUpdating = False > > r = r + 1 > > Next i > > End If > > End With > > > > '************************************************************************************************* > > 'FORMAT CELLS > > Application.ScreenUpdating = False > > ActiveSheet.Select > > Columns("A:A").ColumnWidth = 20 > > Columns("A:A").Select > > With Selection > > .HorizontalAlignment = xlCenter > > .VerticalAlignment = xlBottom > > .WrapText = False > > .Orientation = 0 > > .AddIndent = False > > .IndentLevel = 0 > > .ShrinkToFit = False > > .ReadingOrder = xlContext > > .MergeCells = False > > End With > > > > > > > > Dim myCell As Range > > Dim myStr As String > > > > Range("A1").Select > > Set myCell = Worksheets("defaults").Range("C3") > > > > myStr = "=""LST Files Found Under ""&" & myCell.Address(external:=True) > > & "&"" Directory""" > > > > ActiveCell.Formula = myStr > > > > End Sub > > > > ‘End Program > > '*********************************************************************** > > |
|
||
|
||||
|
=?Utf-8?B?SkxhdGhhbQ==?=
Guest
Posts: n/a
|
Sometimes the old ways are the easier ways... at least for me. Glad I could
help. As I said, I don't use the .FileSearch myself, so I could be totally off base here, but I think maybe the development of the filename and path as you were doing may have been creating a path\filename that was confusing things. Not sure, didn't test it. It just looks a whole lot more complex than anything should ever look, whether it's right or not :-) "maperalia" wrote: > JLatham; > Thanks very much. It is working PERFECTLY!!!!! > > Maperalia > > "JLatham" wrote: > > > Sorry, I'm kind of an old fashioned type, so I didn't even mess with > > .FileSearch and came up with this for you: > > > > Sub List_lst_Files() > > Const basicPath = "S:\GEOTESTS\shears\" > > Const listSheetName = "List of lst Files" > > Dim anyFileName As String > > Dim searchFor As String > > Dim rOffset As Long > > Dim listBaseCell As Range > > > > 'test for existing sheet named 'List of lst Files' > > On Error Resume Next > > Worksheets(listSheetName).Cells.Clear > > If Err <> 0 Then > > Err.Clear > > On Error GoTo 0 > > Worksheets.Add after:=Worksheets(Worksheets.Count) > > ActiveSheet.Name = listSheetName > > End If > > On Error GoTo 0 > > Set listBaseCell = Worksheets(listSheetName).Range("A1") > > > > 'build path/name that looks like > > 'S:\GEOTEST\shears\AAAA\G20@100*.lst" > > 'to use as mask for DIR$() function > > searchFor = basicPath & _ > > Worksheets("DEFAULTS").Range("C3").Value & "\" & _ > > Worksheets("DEFAULTS").Range("C5").Value & "@" & _ > > Worksheets("DEFAULTS").Range("C6").Value & "*.lst" > > anyFileName = Dir$(searchFor) > > Do While anyFileName <> "" > > listBaseCell.Offset(rOffset, 0) = anyFileName > > rOffset = rOffset + 1 > > anyFileName = Dir$ ' gets next match for original 'mask' > > Loop > > set listBaseCell = Nothing ' release resource > > End Sub > > > > > > "maperalia" wrote: > > > > > I wonder If somebody can help me with this matter. > > > I have a program that finds the “lst” files located under the directory > > > described on the cell”C3”. > > > However, when I call these files I got all the files located under this > > > directory where sometimes more than 1000 files are found under this > > > directory. The fact is that I just need three or four of them. > > > > > > I have been trying to make it run accordingly what I need (see macro below). > > > However, I could not make it work. I wonder if I can get just the files I > > > need. For example, if the cell “C3” has the description AAAA, cell “C5” has > > > the description G20, and the cell “C6” has the description 100. I want to > > > call the files under the directory AAAA which have the following files: > > > G20@100A > > > G20@100B > > > G20@100C > > > G20@100D > > > Sometimes, there are just three of them (A, B, and C) and sometimes are four > > > (A, B, C, and D). > > > Could you please check my program and let me know where I am failing because > > > I can not make it run. > > > > > > Thanks in advance. > > > Maperalia > > > > > > > > > > > > > > > > > > '*********************************************************************** > > > ‘Start Program > > > Sub List_lst_Files() > > > > > > Dim FName As String > > > Dim r As Integer > > > Dim i As Long > > > Dim MyPath As String > > > Dim WO As String > > > Dim EXCAVATION As String > > > Dim depth As String > > > Dim Filename As String > > > Dim PostLetter As String > > > > > > Const strFileType As String = "lst" '<<===== CHANGE > > > 'With ActiveSheet.Columns(1) > > > '.Hyperlinks.Delete > > > '.ClearContents > > > 'End With > > > > > > Application.ScreenUpdating = False > > > WO = Worksheets("DEFAULTS").Range("C3") > > > 'WO = Application.InputBox("Enter Work Order Number") > > > > > > > > > > > > EXCAVATION = Worksheets("DEFAULTS").Range("C5") > > > depth = Worksheets("DEFAULTS").Range("C6") > > > PostLetter = A,B,C,D > > > Filename = "" & EXCAVATION & "& ""@"" &" & depth & """PostLetter""" > > > MyPath = "S:\GEOTEST\shears\" & WO & "\" & Filename & ".lst" > > > > > > > > > > > > > > > On Error Resume Next > > > Worksheets("List of lst Files").Delete > > > On Error GoTo 0 > > > Application.DisplayAlerts = False > > > Worksheets.Add.Name = "List of lst Files" > > > > > > Application.ScreenUpdating = False > > > r = 2 > > > With Application.FileSearch > > > .NewSearch > > > .LookIn = MyPath > > > .SearchSubFolders = True > > > .Filename = "*." & strFileType > > > If .Execute() > 0 Then > > > For i = 1 To .FoundFiles.Count > > > FName = Mid(.FoundFiles(i), 1) > > > Cells(r, 1) = Mid(FName, Len(MyPath) + 1, 255) > > > > > > > > > > > > > > > Application.ScreenUpdating = False > > > r = r + 1 > > > Next i > > > End If > > > End With > > > > > > '************************************************************************************************* > > > 'FORMAT CELLS > > > Application.ScreenUpdating = False > > > ActiveSheet.Select > > > Columns("A:A").ColumnWidth = 20 > > > Columns("A:A").Select > > > With Selection > > > .HorizontalAlignment = xlCenter > > > .VerticalAlignment = xlBottom > > > .WrapText = False > > > .Orientation = 0 > > > .AddIndent = False > > > .IndentLevel = 0 > > > .ShrinkToFit = False > > > .ReadingOrder = xlContext > > > .MergeCells = False > > > End With > > > > > > > > > > > > Dim myCell As Range > > > Dim myStr As String > > > > > > Range("A1").Select > > > Set myCell = Worksheets("defaults").Range("C3") > > > > > > myStr = "=""LST Files Found Under ""&" & myCell.Address(external:=True) > > > & "&"" Directory""" > > > > > > ActiveCell.Formula = myStr > > > > > > End Sub > > > > > > ‘End Program > > > '*********************************************************************** > > > |
|
||
|
||||
|
=?Utf-8?B?bWFwZXJhbGlh?=
Guest
Posts: n/a
|
JLatham;
I have been running the program without problem. However, last time I made a mistake and click the macro twice. So I saw that everything was completely twisted. Well my file is as read only so I did not have problem to restore it. I wonder if you can give and statement to avoid this problem. For example, ii I click the first time will create the sheet with the list; however, if I click after the first time will delete the sheet and create the same one or do nothing. The previous macro I had has the following statement: On Error Resume Next Application.DisplayAlerts = False Worksheets("List of lst Files").Delete On Error GoTo 0 Application.DisplayAlerts = False Worksheets.Add.Name = "List of lst Files" Application.DisplayAlerts = True This statement works find in the previous macro; however, I have tried to make it work in the macro you sent me and are not working. Could you please help me to adjust it? Thanks. Maperalia "JLatham" wrote: > Sometimes the old ways are the easier ways... at least for me. Glad I could > help. > > As I said, I don't use the .FileSearch myself, so I could be totally off > base here, but I think maybe the development of the filename and path as you > were doing may have been creating a path\filename that was confusing things. > Not sure, didn't test it. It just looks a whole lot more complex than > anything should ever look, whether it's right or not :-) > > "maperalia" wrote: > > > JLatham; > > Thanks very much. It is working PERFECTLY!!!!! > > > > Maperalia > > > > "JLatham" wrote: > > > > > Sorry, I'm kind of an old fashioned type, so I didn't even mess with > > > .FileSearch and came up with this for you: > > > > > > Sub List_lst_Files() > > > Const basicPath = "S:\GEOTESTS\shears\" > > > Const listSheetName = "List of lst Files" > > > Dim anyFileName As String > > > Dim searchFor As String > > > Dim rOffset As Long > > > Dim listBaseCell As Range > > > > > > 'test for existing sheet named 'List of lst Files' > > > On Error Resume Next > > > Worksheets(listSheetName).Cells.Clear > > > If Err <> 0 Then > > > Err.Clear > > > On Error GoTo 0 > > > Worksheets.Add after:=Worksheets(Worksheets.Count) > > > ActiveSheet.Name = listSheetName > > > End If > > > On Error GoTo 0 > > > Set listBaseCell = Worksheets(listSheetName).Range("A1") > > > > > > 'build path/name that looks like > > > 'S:\GEOTEST\shears\AAAA\G20@100*.lst" > > > 'to use as mask for DIR$() function > > > searchFor = basicPath & _ > > > Worksheets("DEFAULTS").Range("C3").Value & "\" & _ > > > Worksheets("DEFAULTS").Range("C5").Value & "@" & _ > > > Worksheets("DEFAULTS").Range("C6").Value & "*.lst" > > > anyFileName = Dir$(searchFor) > > > Do While anyFileName <> "" > > > listBaseCell.Offset(rOffset, 0) = anyFileName > > > rOffset = rOffset + 1 > > > anyFileName = Dir$ ' gets next match for original 'mask' > > > Loop > > > set listBaseCell = Nothing ' release resource > > > End Sub > > > > > > > > > "maperalia" wrote: > > > > > > > I wonder If somebody can help me with this matter. > > > > I have a program that finds the “lst” files located under the directory > > > > described on the cell”C3”. > > > > However, when I call these files I got all the files located under this > > > > directory where sometimes more than 1000 files are found under this > > > > directory. The fact is that I just need three or four of them. > > > > > > > > I have been trying to make it run accordingly what I need (see macro below). > > > > However, I could not make it work. I wonder if I can get just the files I > > > > need. For example, if the cell “C3” has the description AAAA, cell “C5” has > > > > the description G20, and the cell “C6” has the description 100. I want to > > > > call the files under the directory AAAA which have the following files: > > > > G20@100A > > > > G20@100B > > > > G20@100C > > > > G20@100D > > > > Sometimes, there are just three of them (A, B, and C) and sometimes are four > > > > (A, B, C, and D). > > > > Could you please check my program and let me know where I am failing because > > > > I can not make it run. > > > > > > > > Thanks in advance. > > > > Maperalia > > > > > > > > > > > > > > > > > > > > > > > > '*********************************************************************** > > > > ‘Start Program > > > > Sub List_lst_Files() > > > > > > > > Dim FName As String > > > > Dim r As Integer > > > > Dim i As Long > > > > Dim MyPath As String > > > > Dim WO As String > > > > Dim EXCAVATION As String > > > > Dim depth As String > > > > Dim Filename As String > > > > Dim PostLetter As String > > > > > > > > Const strFileType As String = "lst" '<<===== CHANGE > > > > 'With ActiveSheet.Columns(1) > > > > '.Hyperlinks.Delete > > > > '.ClearContents > > > > 'End With > > > > > > > > Application.ScreenUpdating = False > > > > WO = Worksheets("DEFAULTS").Range("C3") > > > > 'WO = Application.InputBox("Enter Work Order Number") > > > > > > > > > > > > > > > > EXCAVATION = Worksheets("DEFAULTS").Range("C5") > > > > depth = Worksheets("DEFAULTS").Range("C6") > > > > PostLetter = A,B,C,D > > > > Filename = "" & EXCAVATION & "& ""@"" &" & depth & """PostLetter""" > > > > MyPath = "S:\GEOTEST\shears\" & WO & "\" & Filename & ".lst" > > > > > > > > > > > > > > > > > > > > On Error Resume Next > > > > Worksheets("List of lst Files").Delete > > > > On Error GoTo 0 > > > > Application.DisplayAlerts = False > > > > Worksheets.Add.Name = "List of lst Files" > > > > > > > > Application.ScreenUpdating = False > > > > r = 2 > > > > With Application.FileSearch > > > > .NewSearch > > > > .LookIn = MyPath > > > > .SearchSubFolders = True > > > > .Filename = "*." & strFileType > > > > If .Execute() > 0 Then > > > > For i = 1 To .FoundFiles.Count > > > > FName = Mid(.FoundFiles(i), 1) > > > > Cells(r, 1) = Mid(FName, Len(MyPath) + 1, 255) > > > > > > > > > > > > > > > > > > > > Application.ScreenUpdating = False > > > > r = r + 1 > > > > Next i > > > > End If > > > > End With > > > > > > > > '************************************************************************************************* > > > > 'FORMAT CELLS > > > > Application.ScreenUpdating = False > > > > ActiveSheet.Select > > > > Columns("A:A").ColumnWidth = 20 > > > > Columns("A:A").Select > > > > With Selection > > > > .HorizontalAlignment = xlCenter > > > > .VerticalAlignment = xlBottom > > > > .WrapText = False > > > > .Orientation = 0 > > > > .AddIndent = False > > > > .IndentLevel = 0 > > > > .ShrinkToFit = False > > > > .ReadingOrder = xlContext > > > > .MergeCells = False > > > > End With > > > > > > > > > > > > > > > > Dim myCell As Range > > > > Dim myStr As String > > > > > > > > Range("A1").Select > > > > Set myCell = Worksheets("defaults").Range("C3") > > > > > > > > myStr = "=""LST Files Found Under ""&" & myCell.Address(external:=True) > > > > & "&"" Directory""" > > > > > > > > ActiveCell.Formula = myStr > > > > > > > > End Sub > > > > > > > > ‘End Program > > > > '*********************************************************************** > > > > |
|
||
|
||||
|
=?Utf-8?B?bWFwZXJhbGlh?=
Guest
Posts: n/a
|
JLaham;
Do do not worry I made it run!!!!! Thanks anyway for you help. Maperalia "JLatham" wrote: > Sometimes the old ways are the easier ways... at least for me. Glad I could > help. > > As I said, I don't use the .FileSearch myself, so I could be totally off > base here, but I think maybe the development of the filename and path as you > were doing may have been creating a path\filename that was confusing things. > Not sure, didn't test it. It just looks a whole lot more complex than > anything should ever look, whether it's right or not :-) > > "maperalia" wrote: > > > JLatham; > > Thanks very much. It is working PERFECTLY!!!!! > > > > Maperalia > > > > "JLatham" wrote: > > > > > Sorry, I'm kind of an old fashioned type, so I didn't even mess with > > > .FileSearch and came up with this for you: > > > > > > Sub List_lst_Files() > > > Const basicPath = "S:\GEOTESTS\shears\" > > > Const listSheetName = "List of lst Files" > > > Dim anyFileName As String > > > Dim searchFor As String > > > Dim rOffset As Long > > > Dim listBaseCell As Range > > > > > > 'test for existing sheet named 'List of lst Files' > > > On Error Resume Next > > > Worksheets(listSheetName).Cells.Clear > > > If Err <> 0 Then > > > Err.Clear > > > On Error GoTo 0 > > > Worksheets.Add after:=Worksheets(Worksheets.Count) > > > ActiveSheet.Name = listSheetName > > > End If > > > On Error GoTo 0 > > > Set listBaseCell = Worksheets(listSheetName).Range("A1") > > > > > > 'build path/name that looks like > > > 'S:\GEOTEST\shears\AAAA\G20@100*.lst" > > > 'to use as mask for DIR$() function > > > searchFor = basicPath & _ > > > Worksheets("DEFAULTS").Range("C3").Value & "\" & _ > > > Worksheets("DEFAULTS").Range("C5").Value & "@" & _ > > > Worksheets("DEFAULTS").Range("C6").Value & "*.lst" > > > anyFileName = Dir$(searchFor) > > > Do While anyFileName <> "" > > > listBaseCell.Offset(rOffset, 0) = anyFileName > > > rOffset = rOffset + 1 > > > anyFileName = Dir$ ' gets next match for original 'mask' > > > Loop > > > set listBaseCell = Nothing ' release resource > > > End Sub > > > > > > > > > "maperalia" wrote: > > > > > > > I wonder If somebody can help me with this matter. > > > > I have a program that finds the “lst” files located under the directory > > > > described on the cell”C3”. > > > > However, when I call these files I got all the files located under this > > > > directory where sometimes more than 1000 files are found under this > > > > directory. The fact is that I just need three or four of them. > > > > > > > > I have been trying to make it run accordingly what I need (see macro below). > > > > However, I could not make it work. I wonder if I can get just the files I > > > > need. For example, if the cell “C3” has the description AAAA, cell “C5” has > > > > the description G20, and the cell “C6” has the description 100. I want to > > > > call the files under the directory AAAA which have the following files: > > > > G20@100A > > > > G20@100B > > > > G20@100C > > > > G20@100D > > > > Sometimes, there are just three of them (A, B, and C) and sometimes are four > > > > (A, B, C, and D). > > > > Could you please check my program and let me know where I am failing because > > > > I can not make it run. > > > > > > > > Thanks in advance. > > > > Maperalia > > > > > > > > > > > > > > > > > > > > > > > > '*********************************************************************** > > > > ‘Start Program > > > > Sub List_lst_Files() > > > > > > > > Dim FName As String > > > > Dim r As Integer > > > > Dim i As Long > > > > Dim MyPath As String > > > > Dim WO As String > > > > Dim EXCAVATION As String > > > > Dim depth As String > > > > Dim Filename As String > > > > Dim PostLetter As String > > > > > > > > Const strFileType As String = "lst" '<<===== CHANGE > > > > 'With ActiveSheet.Columns(1) > > > > '.Hyperlinks.Delete > > > > '.ClearContents > > > > 'End With > > > > > > > > Application.ScreenUpdating = False > > > > WO = Worksheets("DEFAULTS").Range("C3") > > > > 'WO = Application.InputBox("Enter Work Order Number") > > > > > > > > > > > > > > > > EXCAVATION = Worksheets("DEFAULTS").Range("C5") > > > > depth = Worksheets("DEFAULTS").Range("C6") > > > > PostLetter = A,B,C,D > > > > Filename = "" & EXCAVATION & "& ""@"" &" & depth & """PostLetter""" > > > > MyPath = "S:\GEOTEST\shears\" & WO & "\" & Filename & ".lst" > > > > > > > > > > > > > > > > > > > > On Error Resume Next > > > > Worksheets("List of lst Files").Delete > > > > On Error GoTo 0 > > > > Application.DisplayAlerts = False > > > > Worksheets.Add.Name = "List of lst Files" > > > > > > > > Application.ScreenUpdating = False > > > > r = 2 > > > > With Application.FileSearch > > > > .NewSearch > > > > .LookIn = MyPath > > > > .SearchSubFolders = True > > > > .Filename = "*." & strFileType > > > > If .Execute() > 0 Then > > > > For i = 1 To .FoundFiles.Count > > > > FName = Mid(.FoundFiles(i), 1) > > > > Cells(r, 1) = Mid(FName, Len(MyPath) + 1, 255) > > > > > > > > > > > > > > > > > > > > Application.ScreenUpdating = False > > > > r = r + 1 > > > > Next i > > > > End If > > > > End With > > > > > > > > '************************************************************************************************* > > > > 'FORMAT CELLS > > > > Application.ScreenUpdating = False > > > > ActiveSheet.Select > > > > Columns("A:A").ColumnWidth = 20 > > > > Columns("A:A").Select > > > > With Selection > > > > .HorizontalAlignment = xlCenter > > > > .VerticalAlignment = xlBottom > > > > .WrapText = False > > > > .Orientation = 0 > > > > .AddIndent = False > > > > .IndentLevel = 0 > > > > .ShrinkToFit = False > > > > .ReadingOrder = xlContext > > > > .MergeCells = False > > > > End With > > > > > > > > > > > > > > > > Dim myCell As Range > > > > Dim myStr As String > > > > > > > > Range("A1").Select > > > > Set myCell = Worksheets("defaults").Range("C3") > > > > > > > > myStr = "=""LST Files Found Under ""&" & myCell.Address(external:=True) > > > > & "&"" Directory""" > > > > > > > > ActiveCell.Formula = myStr > > > > > > > > End Sub > > > > > > > > ‘End Program > > > > '*********************************************************************** > > > > |
|
||
|
||||
|
=?Utf-8?B?SkxhdGhhbQ==?=
Guest
Posts: n/a
|
So you're good to go now?
"maperalia" wrote: > JLaham; > Do do not worry I made it run!!!!! > > Thanks anyway for you help. > > Maperalia > > "JLatham" wrote: > > > Sometimes the old ways are the easier ways... at least for me. Glad I could > > help. > > > > As I said, I don't use the .FileSearch myself, so I could be totally off > > base here, but I think maybe the development of the filename and path as you > > were doing may have been creating a path\filename that was confusing things. > > Not sure, didn't test it. It just looks a whole lot more complex than > > anything should ever look, whether it's right or not :-) > > > > "maperalia" wrote: > > > > > JLatham; > > > Thanks very much. It is working PERFECTLY!!!!! > > > > > > Maperalia > > > > > > "JLatham" wrote: > > > > > > > Sorry, I'm kind of an old fashioned type, so I didn't even mess with > > > > .FileSearch and came up with this for you: > > > > > > > > Sub List_lst_Files() > > > > Const basicPath = "S:\GEOTESTS\shears\" > > > > Const listSheetName = "List of lst Files" > > > > Dim anyFileName As String > > > > Dim searchFor As String > > > > Dim rOffset As Long > > > > Dim listBaseCell As Range > > > > > > > > 'test for existing sheet named 'List of lst Files' > > > > On Error Resume Next > > > > Worksheets(listSheetName).Cells.Clear > > > > If Err <> 0 Then > > > > Err.Clear > > > > On Error GoTo 0 > > > > Worksheets.Add after:=Worksheets(Worksheets.Count) > > > > ActiveSheet.Name = listSheetName > > > > End If > > > > On Error GoTo 0 > > > > Set listBaseCell = Worksheets(listSheetName).Range("A1") > > > > > > > > 'build path/name that looks like > > > > 'S:\GEOTEST\shears\AAAA\G20@100*.lst" > > > > 'to use as mask for DIR$() function > > > > searchFor = basicPath & _ > > > > Worksheets("DEFAULTS").Range("C3").Value & "\" & _ > > > > Worksheets("DEFAULTS").Range("C5").Value & "@" & _ > > > > Worksheets("DEFAULTS").Range("C6").Value & "*.lst" > > > > anyFileName = Dir$(searchFor) > > > > Do While anyFileName <> "" > > > > listBaseCell.Offset(rOffset, 0) = anyFileName > > > > rOffset = rOffset + 1 > > > > anyFileName = Dir$ ' gets next match for original 'mask' > > > > Loop > > > > set listBaseCell = Nothing ' release resource > > > > End Sub > > > > > > > > > > > > "maperalia" wrote: > > > > > > > > > I wonder If somebody can help me with this matter. > > > > > I have a program that finds the “lst” files located under the directory > > > > > described on the cell”C3”. > > > > > However, when I call these files I got all the files located under this > > > > > directory where sometimes more than 1000 files are found under this > > > > > directory. The fact is that I just need three or four of them. > > > > > > > > > > I have been trying to make it run accordingly what I need (see macro below). > > > > > However, I could not make it work. I wonder if I can get just the files I > > > > > need. For example, if the cell “C3” has the description AAAA, cell “C5” has > > > > > the description G20, and the cell “C6” has the description 100. I want to > > > > > call the files under the directory AAAA which have the following files: > > > > > G20@100A > > > > > G20@100B > > > > > G20@100C > > > > > G20@100D > > > > > Sometimes, there are just three of them (A, B, and C) and sometimes are four > > > > > (A, B, C, and D). > > > > > Could you please check my program and let me know where I am failing because > > > > > I can not make it run. > > > > > > > > > > Thanks in advance. > > > > > Maperalia > > > > > > > > > > > > > > > > > > > > > > > > > > > > > > '*********************************************************************** > > > > > ‘Start Program > > > > > Sub List_lst_Files() > > > > > > > > > > Dim FName As String > > > > > Dim r As Integer > > > > > Dim i As Long > > > > > Dim MyPath As String > > > > > Dim WO As String > > > > > Dim EXCAVATION As String > > > > > Dim depth As String > > > > > Dim Filename As String > > > > > Dim PostLetter As String > > > > > > > > > > Const strFileType As String = "lst" '<<===== CHANGE > > > > > 'With ActiveSheet.Columns(1) > > > > > '.Hyperlinks.Delete > > > > > '.ClearContents > > > > > 'End With > > > > > > > > > > Application.ScreenUpdating = False > > > > > WO = Worksheets("DEFAULTS").Range("C3") > > > > > 'WO = Application.InputBox("Enter Work Order Number") > > > > > > > > > > > > > > > > > > > > EXCAVATION = Worksheets("DEFAULTS").Range("C5") > > > > > depth = Worksheets("DEFAULTS").Range("C6") > > > > > PostLetter = A,B,C,D > > > > > Filename = "" & EXCAVATION & "& ""@"" &" & depth & """PostLetter""" > > > > > MyPath = "S:\GEOTEST\shears\" & WO & "\" & Filename & ".lst" > > > > > > > > > > > > > > > > > > > > > > > > > On Error Resume Next > > > > > Worksheets("List of lst Files").Delete > > > > > On Error GoTo 0 > > > > > Application.DisplayAlerts = False > > > > > Worksheets.Add.Name = "List of lst Files" > > > > > > > > > > Application.ScreenUpdating = False > > > > > r = 2 > > > > > With Application.FileSearch > > > > > .NewSearch > > > > > .LookIn = MyPath > > > > > .SearchSubFolders = True > > > > > .Filename = "*." & strFileType > > > > > If .Execute() > 0 Then > > > > > For i = 1 To .FoundFiles.Count > > > > > FName = Mid(.FoundFiles(i), 1) > > > > > Cells(r, 1) = Mid(FName, Len(MyPath) + 1, 255) > > > > > > > > > > > > > > > > > > > > > > > > > Application.ScreenUpdating = False > > > > > r = r + 1 > > > > > Next i > > > > > End If > > > > > End With > > > > > > > > > > '************************************************************************************************* > > > > > 'FORMAT CELLS > > > > > Application.ScreenUpdating = False > > > > > ActiveSheet.Select > > > > > Columns("A:A").ColumnWidth = 20 > > > > > Columns("A:A").Select > > > > > With Selection > > > > > .HorizontalAlignment = xlCenter > > > > > .VerticalAlignment = xlBottom > > > > > .WrapText = False > > > > > .Orientation = 0 > > > > > .AddIndent = False > > > > > .IndentLevel = 0 > > > > > .ShrinkToFit = False > > > > > .ReadingOrder = xlContext > > > > > .MergeCells = False > > > > > End With > > > > > > > > > > > > > > > > > > > > Dim myCell As Range > > > > > Dim myStr As String > > > > > > > > > > Range("A1").Select > > > > > Set myCell = Worksheets("defaults").Range("C3") > > > > > > > > > > myStr = "=""LST Files Found Under ""&" & myCell.Address(external:=True) > > > > > & "&"" Directory""" > > > > > > > > > > ActiveCell.Formula = myStr > > > > > > > > > > End Sub > > > > > > > > > > ‘End Program > > > > > '*********************************************************************** > > > > > |
|
||
|
||||
|
|
|
| |
![]() |
| Thread Tools | |
| Rate This Thread | |
|
|
Similar Threads
|
||||
| Thread | Thread Starter | Forum | Replies | Last Post |
| Return list of file names from specific directory | Chad | Microsoft Excel Programming | 3 | 7th May 2008 03:53 AM |
| HOW TO VIEW SPECIFIC COLUMNS for A CALL LIST? | la90292 | Microsoft Excel New Users | 5 | 3rd Feb 2006 05:08 PM |
| Populate List Box with Files from a specific directory | Norma | Microsoft Access VBA Modules | 2 | 3rd Mar 2004 08:34 PM |
| Copy all files and sub-directory under a specific directory | Phil | Microsoft Access | 1 | 20th Dec 2003 11:06 AM |
| Number of Specific Files in A Directory | Amy L. | Microsoft Dot NET | 2 | 8th Sep 2003 10:31 AM |
Powered by vBulletin®. Copyright ©2000 - 2012, Jelsoft Enterprises Ltd.
SEO by vBSEO ©2010, Crawlability, Inc. |




