Wrox Programmer Forums
Go Back   Wrox Programmer Forums > Microsoft Office > Excel VBA > Excel VBA
| 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 software programmers and website developers including Wrox book authors and readers. New member registration was closed in 2019. New posts were shut off and the site was archived into this static format as of October 1, 2020. If you require technical support for a Wrox book please contact http://hub.wiley.com
  #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

  #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?

  #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


  #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



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





Powered by vBulletin®
Copyright ©2000 - 2020, Jelsoft Enterprises Ltd.
Copyright (c) 2020 John Wiley & Sons, Inc.