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").Acti vate
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").Acti vate
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

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,



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").Acti vate
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").Acti vate
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

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,

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,

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,

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,