Quicker way than OpenText to read text files?

[dancingcab]

Hi all,

I have a large number of text files containing five tab delimited columns and several hundred rows. I currently have a macro that opens the text file, finds and calculates the required 'results' then pastes these into a new summary sheet. It's currently taking around 1 second per file, which seems quite slow to me.

I'm wondering if there is a quicker way to read the data from the text files and export the required 'results' without having to open each text file in excel? I'm new to VBA so any advice is greatly appreciated.

This is my code:

Sub Results()

Call GetFolder

Application.ScreenUpdating = False
Application.DisplayStatusBar = True
Application.StatusBar = "Calculating CA Results....."

Call CreateSummary 'This creates the summary sheet with all the correct titles etc
NRow = 5
sFile = Dir(sPath & Application.PathSeparator & "*(1).txt")
'Do While sFile <> ""
Do While Len(sFile) > 0
Workbooks.OpenText FileName:=sPath & "\" & sFile _
, DataType:=xlDelimited, Tab:=True
myFile = ActiveWorkbook.Name
Call CAAnalysis 'This calculates the required results - see below
Set DestRange = Sheet1.Range("B" & NRow)
NRow = NRow + DestRange.Rows.Count


sFile = Dir()
Loop


The code for CAAnalaysis is:

Sub CAAnalysis()
Dim Start1 As Integer
Dim End1 As Integer
Dim AveCurrent1 As Single


Start1 = [MATCH(0.05, ROUND(A:A,5),0)]
End1 = [MATCH(0.15, ROUND(A:A,5),0)]
AveCurrent1 = WorksheetFunction.Average(Range(Cells(Start1, "D"), Cells(End1, "D"))) * 1000000000


ActiveWorkbook.Close False
Windows("Results.xlsx").Activate

Range("A" & NRow).Value = myFile
Range("B" & NRow) = AveCurrent1

End Sub

Thanks!

 

[Darren Bartrup]

I'm not sure what you're trying to do with the contents of the file once you have it in memory, but try this:

'----------------------------------------------------------------------
' ReadTextFile
'
'   Reads the text file and returns it as a string.
'----------------------------------------------------------------------
Public Function ReadTextFile(FileName As String) As String


    Dim mFSO As Object
    Set mFSO = CreateObject("Scripting.FileSystemObject")


    On Error Resume Next
    ReadTextFile = mFSO.OpenTextFile(FileName).ReadAll
    Err.Clear
    
End Function




Public Sub Test()


    Debug.Print ReadTextFile("C:\New Text Document.txt")


End Sub

Edit: If you want to find the tabs and line breaks in the document:
Character code 10 & 13 for a line break, character code 9 for a tab.

Asc(Mid("Text", 2, 1)) - will return the character code for the second character.