Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Search location and sub dir's for file, then open it.
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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Search location and sub dir's for file, then open it.
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 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Search location and sub dir's for file, then open it.
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, |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Search location and sub dir's for file, then open it.
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, |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Search location and sub dir's for file, then open it.
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, |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Search location and sub dir's for file, then open it.
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, |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
VBA to ask for file location and use to open DB | Excel Worksheet Functions | |||
File Open Dialogue Box to a Specified Location | Excel Programming | |||
Open File from FTP Location | Excel Discussion (Misc queries) | |||
Open file on FTP location | Excel Programming | |||
Open File Location | Excel Programming |