|
Subject:
|
Please Help! Opening Multiple files
|
|
Posted By:
|
jezywrap
|
Post Date:
|
12/16/2005 12:12:41 PM
|
I need to open about 2000 flat files that are delimited by | . Each file is incremented by 1 for example br0004 ... 0005 ... 0006 but then they jump to BR1000 there are gaps in the numbering. These files are all located in the same folder. The object is to open each flat file and put the data into one sheet one record after the other. Some files have one record and some files have many records. Does anyone have any suggestions?
Thank You
|
|
Reply By:
|
shattered
|
Reply Date:
|
12/19/2005 10:18:20 AM
|
Sub TestData3()
sPath = "C:\TestData\" ' Directory containing files
sSplit = "|" ' Delimiter character
sFileName = Dir(sPath)
Do Until Len(sFileName) = 0
If (sFileName <> ".") And (sFileName <> "..") Then
iRow = GetNextRow("Sheet1")
lFNum = FreeFile
Open (sPath & sFileName) For Input As lFNum
Do While Not EOF(lFNum)
Line Input #lFNum, sInput
vaFields = Split(sInput, sSplit)
For i = 0 To UBound(vaFields)
Sheet1.Cells(iRow, i + 1).Value = vaFields(i)
Next i
iRow = iRow + 1
Loop
Close lFNum
End If
sFileName = Dir()
Loop
End Sub
should do?
|
|
Reply By:
|
mjppaba
|
Reply Date:
|
12/19/2005 11:28:21 AM
|
Hi
Alternatively try this for size!!
Sub mdl_ForEachFileInFiles()
Dim myCurrDir As String
Dim myFScript
Dim myFolder
Dim myFile
Dim myFileCollection
Dim myString
Dim mySheetName As String
Dim myCurrWkBk As String
myCurrDir = "C:\TestData\"
myCurrWkBk = ActiveWorkbook.Name
Set myFScript = CreateObject("Scripting.FileSystemObject")
Set myFolder = myFScript.GetFolder(myCurrDir)
Set myFileCollection = myFolder.Files
For Each myFile In myFileCollection
Workbooks.Open (myCurrDir & "\" & myFile.Name)
mySheetName = ActiveSheet.Name
Range("A1").CurrentRegion.Copy
Workbooks(myCurrWkBk).Sheets(1).Activate
Range("A65000").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Application.CutCopyMode = False
Workbooks(myFile.Name).Close savechanges:=False
Next
End Sub
cheers
Matt
|
|
Reply By:
|
mjppaba
|
Reply Date:
|
12/19/2005 11:34:32 AM
|
Oops silly me, did I forget the Text to columns bit! Sorry
Sub mdl_ForEachFileInFiles()
Dim myCurrDir As String
Dim myFScript
Dim myFolder
Dim myFile
Dim myFileCollection
Dim myString
Dim mySheetName As String
Dim myCurrWkBk As String
myCurrDir = "C:\TestData\"
myCurrWkBk = ActiveWorkbook.Name
Set myFScript = CreateObject("Scripting.FileSystemObject")
Set myFolder = myFScript.GetFolder(myCurrDir)
Set myFileCollection = myFolder.Files
For Each myFile In myFileCollection
Workbooks.Open (myCurrDir & "\" & myFile.Name)
mySheetName = ActiveSheet.Name
Range("A1").CurrentRegion.Copy
Workbooks(myCurrWkBk).Sheets(1).Activate
Range("A65000").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Application.CutCopyMode = False
Workbooks(myFile.Name).Close savechanges:=False
Next
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"), OtherChar:="|"
End Sub
Cheers
Matt
|
