Search location and sub dir's for file, then open it.

[Hal]

Greetings,

I recorded and modified the ImportRatedData Sub below and it does an ok job.
What would make it really good would be to have it search a path and its
subfolders for each file named "Rated.dat" and execute the ImportRatedData
Sub.

I know I need to use the Workbooks.OpenText Filename:= for each time an
occurance of "Rated.dat" is found but how to do so, I'm not so clear on.

Thanks,



Sub ImportRatedData()
'
' ImportRatedData Macro
' Macro recorded 5/13/2009 by innesh
'
' Keyboard Shortcut: Ctrl+i
'
Dim RatedHeaderCopy
Dim RatedRowCopy As Integer
Dim RatedRowPaste As Integer
Dim ActiveTab

RatedHeaderCopy = "A1:A7"
' ActiveTab = "DDEC"
' RatedRowCopy = 10
' RatedRowPaste = 14


' Range("A3").Select
Windows("Rated.dat").Activate
If Right(Range("A7"), 4) = "DDEC" Then
ActiveTab = "DDEC"
ElseIf Right(Range("A7"), 4) = "ADEC" Then
ActiveTab = "ADEC"
ElseIf Right(Range("A7"), 4) = "MDEC" Then
ActiveTab = "MDEC"
End If
Range(RatedHeaderCopy).Select
Selection.Copy
Windows("4K_Data_for_Limit_Modification.xls").Activate
Sheets(ActiveTab).Select
RatedRowPaste = Range("A65536").End(xlUp).Row + 1
Range("A" & RatedRowPaste).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:=True
Windows("Rated.dat").Activate
RatedRowCopy = Range("A65536").End(xlUp).Row
Range("E" & RatedRowCopy, "ER" & RatedRowCopy).Select
Application.CutCopyMode = False
Selection.Copy
Windows("4K_Data_for_Limit_Modification.xls").Activate
Range("H" & RatedRowPaste).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("A" & RatedRowPaste + 1).Select
ActiveWorkbook.Save
Windows("Rated.dat").Close
End Sub

 

[joel]

do you want to check multiple levels of sub directories or just the
mainfolder and one level of subdirectories?

 

[Hal]

The directories to look at will be one level below the starting location
which is about three levels below the root directory.

 

[joel]

Try this code. You need to change FolderName to you folder. Dou your want
to close the workbook Workbooks("4K_Data_for_Limit_Modification.xls") at the
end of the macro?

Sub ImportRatedData()
'
' ImportRatedData Macro
' Macro recorded 5/13/2009 by innesh
'
' Keyboard Shortcut: Ctrl+i
'
Dim RatedHeaderCopy
Dim RatedRowCopy As Integer
Dim RatedRowPaste As Integer
Dim ActiveTab

RatedHeaderCopy = "A1:A7"
FolderName = "c:\temp"

Set FSO = CreateObject _
("Scripting.FileSystemObject")
Set Folder = FSO.GetFolder(FolderName)

Set destbk = Workbooks("4K_Data_for_Limit_Modification.xls")


For Each sf In Folder.subfolders
FName = Dir(sf.Name & "\" & "Rated.dat")
FName = Dir(sf.Path & "\" & "*.txt")
If FName <> "" Then

' ActiveTab = "DDEC"
' RatedRowCopy = 10
' RatedRowPaste = 14
Workbooks.OpenText Filename:=sf.Path & "\" & FName
Set Databk = ActiveWorkbook

Set DestSht = destbk.Sheets(Right(Range("A7"), 4))
With DestSht
RatedRowPaste = .Range("A65536").End(xlUp).Row + 1

' Range("A3").Select

.Range(RatedHeaderCopy).Copy _
Destination:=DestSht.Range("A" & RatedRowPaste)
.Range("E" & RatedRowCopy, "ER" & RatedRowCopy).Copy
DestSht.Range("H" & RatedRowPaste).PasteSpecial _
Paste:=xlPasteValues
End With
Databk.Close savechanges:=False
End If

Next sf
destbk.Close savechanges:=True
End Sub

 

[Hal]

Thanks Joel,

I'll try your code. There is no real need to close the workbook the data is
being copied to.

 

[joel]

Remove this line. I have 2 lines that set FName. This one I added fro my
own testing.

FName = Dir(sf.Path & "\" & "*.txt")