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

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


"Hal" wrote:

Thanks Joel,

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

"joel" wrote:

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" wrote:

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

"joel" wrote:

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

"Hal" wrote:

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,