loop folders macro - Sorry for duplicate posts
 

Sorry for my duplicate post if any is showing. I am not seeing my
post so I am attempting again...


This macro has been quite handy for me but I still have to manually
click "yes" to save each file after it has prepped the data. What
can
I add to eliminate from clicking "yes". Thanks for any help in
advance.

Dim aryFiles
Dim oFSO
Sub LoopFolders_Cincinnati()
Dim i As Integer


Set oFSO = CreateObject("Scripting.FileSystemObject")


selectFiles "C:\Documents and Settings\TRACKERS\DATA "


Set oFSO = Nothing


End Sub


'--------------------------------------------------------------------------**-
Sub selectFiles(sPath)
'--------------------------------------------------------------------------**-
Dim Folder As Object
Dim Files As Object
Dim file As Object
Dim fldr


Set Folder = oFSO.GetFolder(sPath)


For Each fldr In Folder.Subfolders
selectFiles fldr.Path
Next fldr


For Each file In Folder.Files
If file.Type = "Microsoft Excel Comma Separated Values File"
Then
Workbooks.Open Filename:=file.Path
Rows("1:1").Select
Selection.Delete Shift:=xlUp
Cells.Select
Selection.Sort Key1:=Range("BW2"), Order1:=xlDescending,
Header:=xlGuess _
, OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal


ActiveWorkbook.Save
ActiveWorkbook.Close
End If
Next file


End Sub

loop folders macro - Sorry for duplicate posts
 

see latest thread

--
HTH

Bob

(there's no email, no snail mail, but somewhere should be gmail in my addy)

"simplymidori" wrote in message
oups.com...
Sorry for my duplicate post if any is showing. I am not seeing my
post so I am attempting again...


This macro has been quite handy for me but I still have to manually
click "yes" to save each file after it has prepped the data. What
can
I add to eliminate from clicking "yes". Thanks for any help in
advance.

Dim aryFiles
Dim oFSO
Sub LoopFolders_Cincinnati()
Dim i As Integer


Set oFSO = CreateObject("Scripting.FileSystemObject")


selectFiles "C:\Documents and Settings\TRACKERS\DATA "


Set oFSO = Nothing


End Sub


'--------------------------------------------------------------------------**-
Sub selectFiles(sPath)
'--------------------------------------------------------------------------**-
Dim Folder As Object
Dim Files As Object
Dim file As Object
Dim fldr


Set Folder = oFSO.GetFolder(sPath)


For Each fldr In Folder.Subfolders
selectFiles fldr.Path
Next fldr


For Each file In Folder.Files
If file.Type = "Microsoft Excel Comma Separated Values File"
Then
Workbooks.Open Filename:=file.Path
Rows("1:1").Select
Selection.Delete Shift:=xlUp
Cells.Select
Selection.Sort Key1:=Range("BW2"), Order1:=xlDescending,
Header:=xlGuess _
, OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal


ActiveWorkbook.Save
ActiveWorkbook.Close
End If
Next file


End Sub