Wrox Programmer Forums

Need to download code?

View our list of code downloads.

Go Back   Wrox Programmer Forums > Microsoft Office > Excel VBA > Excel VBA
Password Reminder
Register
| FAQ | Members List | Calendar | Search | Today's Posts | Mark Forums Read
Excel VBA Discuss using VBA for Excel programming.
Welcome to the p2p.wrox.com Forums.

You are currently viewing the Excel VBA section of the Wrox Programmer to Programmer discussions. This is a community of tens of thousands of software programmers and website developers including Wrox book authors and readers. As a guest, you can read any forum posting. By joining today you can post your own programming questions, respond to other developers’ questions, and eliminate the ads that are displayed to guests. Registration is fast, simple and absolutely free .
DRM-free e-books 300x50
Reply
 
Thread Tools Search this Thread Display Modes
  #1 (permalink)  
Old December 16th, 2005, 01:12 PM
Authorized User
 
Join Date: Dec 2005
Location: , , .
Posts: 30
Thanks: 0
Thanked 0 Times in 0 Posts
Default Please Help! Opening Multiple files

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 With Quote
  #2 (permalink)  
Old December 19th, 2005, 11:18 AM
Authorized User
 
Join Date: Oct 2004
Location: , , .
Posts: 60
Thanks: 0
Thanked 0 Times in 0 Posts
Send a message via AIM to shattered Send a message via Yahoo to shattered
Default

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 With Quote
  #3 (permalink)  
Old December 19th, 2005, 12:28 PM
Friend of Wrox
 
Join Date: Jan 2005
Location: Bournemouth, Dorset, United Kingdom.
Posts: 180
Thanks: 0
Thanked 0 Times in 0 Posts
Default

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 With Quote
  #4 (permalink)  
Old December 19th, 2005, 12:34 PM
Friend of Wrox
 
Join Date: Jan 2005
Location: Bournemouth, Dorset, United Kingdom.
Posts: 180
Thanks: 0
Thanked 0 Times in 0 Posts
Default

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

Reply With Quote
Reply


Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is Off
HTML code is Off
Trackbacks are Off
Pingbacks are On
Refbacks are Off


Similar Threads
Thread Thread Starter Forum Replies Last Post
Opening PDF files comicghozt ASP.NET 1.0 and 1.1 Professional 11 October 23rd, 2006 04:06 AM
Importing Multiple files in Multiple tables Versi Suomi Access 6 June 1st, 2005 08:47 AM
opening files wilbur C# 1 April 20th, 2005 05:54 AM
Multiple windows opening Wango Access 1 May 26th, 2004 03:35 AM
Opening Files Read-Only SerranoG Access VBA 5 May 6th, 2004 02:40 PM



All times are GMT -4. The time now is 06:47 AM.


Powered by vBulletin®
Copyright ©2000 - 2019, Jelsoft Enterprises Ltd.
© 2013 John Wiley & Sons, Inc.