Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations John Tel on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Text File Record Counts? 4

Status
Not open for further replies.

AlexCuse

Programmer
Apr 13, 2006
5,416
US
Hi All,

I am trying to create a VBA Module to accomplish a somewhat simple task. I want it to open each text file within a folder and return the filename and count of records (rows?) within the file. Any advice I could find on this would be very helpful as I work primarily in SQL and am not all that familiar with the more esoteric functions within VBA. Thanks in advance for all your help!

Alex
 
Have a look here:
Pay attention to GetFolder, Files, OpenAsTextStream, ReadlAll and Close.

In the VBA help have a look at the Split and UBound functions, and the vbCrLf constant.

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886
 
this looks like good stuff PH, I think I'll be able to have the foundation of something put together by tomorrow AM. I appreciate your help, and I'll let you know if I run into any problems.
 
OK guys, I am starting to make some progress. I have gotten it to open each file within my folder as a text stream. I've also had some success getting the module to print my filenames and either a single line or all lines in the debug window.

From what you've told me, it seems like I want to count the Cr/Lf characters once I have it open. For some reason I find nothing in help on the vbCrLf constant (I have Visual Studio 6.0 and Access 2000)

Here is what I'm working with now, it seems like what you're aiming for is somehow counting the Carriage Return/Linefeed characters once I have each file open? Or should I be trying to use the ReadAll function to get everything into a recordset for counting? I think you've got me on the right track but a bit more detail could be helpful.

Code:
Public Function RecordCount()

   Dim fso, f, f1, fc, txs, txstest
    
    Dim folderspec          As String
    Dim PathandFile         As String
    Dim curdate As String
    
    curdate = Format(Date, "mmddyy")

    
    folderspec = "directory" 'Location ofSource files
    
    
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set f = fso.GetFolder(folderspec)                    'Specify Folder
    Set fc = f.Files
    
    For Each f1 In fc               'for each file in folderspec

If Right(f1.Name, 4) = ".TXT" Then
    
    Debug.Print f1.Name

   Set txs = f1.OpenAsTextStream(1)      'Opens each file as text stream

   txstest = txs.ReadAll          'Reads all lines within file
   'Debug.Print tstest
   
   txs.Close
       
End If

    Next

End Function

Any more hints on how to actually count the records once I have the file open would be greatly appreciated.

Thanks a lot,

Alex

 
A starting point:
Code:
...
For Each f1 In fc    'for each file in folderspec
  If UCase(Right(f1.Name, 4)) = ".TXT" Then
    Set txs = f1.OpenAsTextStream(1)    'Opens each file as text stream
    Debug.Print 1 + UBound(Split(txs.ReadAll, vbCrLf)), f1.Name
    txs.Close
  End If
Next
...

Hope This Helps, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884 or FAQ181-2886
 

Last summer, in a big text file (~168MB ~200 columns ~70k lines), the lines where counted faster when the file was opened using the old VB OPEN method and walking through the lines and incrementing a line counter. Various methods where used, including the previous mentioned, ado recordset recordcount (many variations of cursors+cursortypes) and others. Of course if the file is of fixed length then you could devide LOF by line 's size.
But this depends on the file size [Columns x Lines].
 
I have a class module (not sure where I got it from originally, but it is pasted below) with a CountNonBlankLines method. This should do what you want:


Option Explicit
' Attribute VB_Name = "ReadTextFile"
' Text File Class for reading files

' Class keeps 3 lines for the programmer to use:
' .Text = current line to work with
' .PreviousLine = the last line.
' .NextLine = The next line for 'look ahead' operations
' (occasionally useful to know what's next!)

' The class has it's own EOF property (EndOfFile).
' Use that rather then the channel's EOF.
' Since the class is doing it's own handling of channel numbers, inputs, etc.,
' using one that the class isn't handling could return erronious information.

' The BytesLeft should also be ignored.
' The class uses it internally for it's own purposes....
' The .LeftOver property is also something that the class uses
' for it's own use. Leave it alone!

' BufferSize can be set to whatever the programmer needs/wants.
' On files that have more then 4096 characters per line,
' this can be changed. Unless that's the case, 4096 bytes
' (the default) usually works quite well.

' The .StripLeadingSpaces and .StripTrailingSpaces properties
' are used for formatting of the line within your program.
' Use as needed/desired.

' The .NoBlankLines property is for use when you'd rather
' not deal with blank lines. Note that this setting doesn't
' apply to the .NextLine propery or the .PreviousLine property.

' The .StripNulls becomes useful in files that are "padded".
' I use this a lot on files that come off of Main Frames and
' are really ment to be printed, rather then read into a program.
' Most files =don't= have nulls (Chr$(0)) in them, so normally
' you'll leave this off. (Turning it on slows the reads!)

' The .OnlyAlphaNumericCharacters property is also fairly useless
' except in some extremely rare conditions. I can't remember why
' I put this in here, it changes the class so that it only
' returns the characters in the ASCII range of 32 - 127
' (Characters that can be printed), but not the so-called
' "upper-ASCII" characters that can also be printed.
' International users will probably find it =much= more
' useless then those in the US.

' The .CountOnlyNonBlankLines is for the count of lines.
' Personally, I almost always leave this set to False as
' I'd rather have a count that is more true to the format
' of the file, but I've had occurances where this is useful.

' You can set the LineDelimiter property to be whatever you
' want/need. This becomes =really= helpful in files that are
' created on systems that don't use either Cr, Lf, or CrLf
' as line delimiters.
' The class will automatically try to figure out what the line
' Delimiter is if you don't set this. It looks for Carridge
' Returns (Chr$(13)), Line Feeds (Chr$(10)) and the 2 of them
' together.
' The class will automatically look for FormFeeds and use those
' as additional Line Delimiters.

' This class can also be used on FixedWidth files.
' Just set the .FixedWidthLineLength property to the length
' of the line, and that's it.
' When the .FixedWidthLineLength >0, the line delimiters
' are ignored, so feel free to do so in your code.

' The methods used are:
' .cfOpen to open the file set in the .FileName property
' .csGetALine which is used to get the next line from the file
' and .cfCloseFile to close the file when you're done with it.
' Watch the .EndOfFile property to know when you're done.

' sample useage:
'Sub ReadAFile(strFileName)
' Dim myTextFile As New ReadTextFile ' Create a new class internal to your program.
' Dim myString As String ' Local String to play with in your program
' Dim intError As Integer
'
' myTextFile.FileName = strFileName ' set the file name to read
' myTextFile.NoBlankLines = True ' Don't return blank lines!
' myTextFile.CountOnlyNonBlankLines = False ' Count all lines regardless of whether or not they are returned
' myTextFile.StripLeadingSpaces = False ' leave any leading spaces.
' myTextFile.StripTrailingSpaces = False ' leave the trailing spaces too!
' myTextFile.StripNulls = True ' eliminate Chr$(0)'s
' myTextFile.OnlyAlphaNumericCharacters = True ' don't send me any characters I can't use!
'
' intError = myTextFile.cfOpenFile ' open the file, return any errors in doing so (class doesn't handle them!)
' If intError = 0 Then
' ' no error in opening the file has occured
' While Not myTextFile.EndOfFile ' Watch for the end of the file
' myTextFile.csGetALine ' Tells the class to go to a new line
' myString = myTextFile.Text ' set your string = to the current string of the class
' Debug.Print myTextFile.LinesRead, myString ' Show work in the Debug window. Optional! Don't do in production!
' ' want to see the next line?
' If myTextFile.NextLine = <whatever> Then....
' ' want to see the Last line?
' If myTextFile.PreviousLine = <whatever> Then ....
' <do whatever with the string here.>
' ' want to find something in the file?
' ' find a line within the file:
' ' myTextFile.csFindLine StringToSearchFor, True
' ' Note: Change True To False if you care about case!
' ' myString = myTextFile.Text
' ' on larger files, you may not want to do a line-by-line
' ' search, so do:
' ' myTextFile.csFindInFile StringToSearchFor, True
' ' myString = myTextFile.Text
' Wend
' Else
' ' handle the error here!
' MsgBox Error(intError)
' End If
' myTextFile.cfCloseFile ' close the file. We're done with it!
' Set myTextFile = Nothing ' Always set your objects to nothing when you're done with them!
'End Sub

' the code itself is below:

'local variable(s) to hold property value(s)
Private mvarBytesLeft As Currency
Private mvarText As String
Private mvarLeftOver As String
Private mvarEndOfFile As Boolean
Private mvarChannelNumber As Integer
Private mvarBufferSize As Long
Private mvarFileName As String
Private mvarNoBlankLines As Boolean
Private mvarStripLeadingSpaces As Boolean
Private mvarStripTrailingSpaces As Boolean
Private mvarLinesRead As Double
Private mvarCountOnlyNonBlankLines As Boolean
Private mvarNextLine As String
Private mvarPreviousLine As String
Private mvarLineDelimiter As String
Private mvarFixedWidthLineLength As Integer
Private mvarOnlyAlphaNumericCharacters As Boolean
Private mvarStripNulls As Boolean
Public Property Let StripNulls(ByVal vData As Boolean)
mvarStripNulls = vData
End Property
Public Property Get StripNulls() As Boolean
StripNulls = mvarStripNulls
End Property
Public Property Let OnlyAlphaNumericCharacters(ByVal vData As Boolean)
mvarOnlyAlphaNumericCharacters = vData
End Property
Public Property Get OnlyAlphaNumericCharacters() As Boolean
OnlyAlphaNumericCharacters = mvarOnlyAlphaNumericCharacters
End Property
Public Property Let FixedWidthLineLength(ByVal vData As Integer)
mvarFixedWidthLineLength = vData
End Property
Public Property Get FixedWidthLineLength() As Integer
FixedWidthLineLength = mvarFixedWidthLineLength
End Property
Public Property Let LineDelimiter(ByVal vData As String)
mvarLineDelimiter = vData
End Property
Public Property Get LineDelimiter() As String
LineDelimiter = mvarLineDelimiter
End Property
Public Property Let PreviousLine(ByVal vData As String)
mvarPreviousLine = vData
End Property
Public Property Get PreviousLine() As String
PreviousLine = mvarPreviousLine
End Property
Public Property Let NextLine(ByVal vData As String)
mvarNextLine = vData
End Property
Public Property Get NextLine() As String
NextLine = mvarNextLine
End Property
Public Property Let CountOnlyNonBlankLines(ByVal vData As Boolean)
mvarCountOnlyNonBlankLines = vData
End Property
Public Property Get CountOnlyNonBlankLines() As Boolean
CountOnlyNonBlankLines = mvarCountOnlyNonBlankLines
End Property
Public Property Let LinesRead(ByVal vData As Double)
mvarLinesRead = vData
End Property
Public Property Get LinesRead() As Double
LinesRead = mvarLinesRead
End Property
Public Property Let StripTrailingSpaces(ByVal vData As Boolean)
mvarStripTrailingSpaces = vData
End Property
Public Property Get StripTrailingSpaces() As Boolean
StripTrailingSpaces = mvarStripTrailingSpaces
End Property
Public Property Let StripLeadingSpaces(ByVal vData As Boolean)
mvarStripLeadingSpaces = vData
End Property
Public Property Get StripLeadingSpaces() As Boolean
StripLeadingSpaces = mvarStripLeadingSpaces
End Property
Public Property Let NoBlankLines(ByVal vData As Boolean)
mvarNoBlankLines = vData
End Property
Public Property Get NoBlankLines() As Boolean
NoBlankLines = mvarNoBlankLines
End Property
Public Property Let FileName(ByVal vData As String)
mvarFileName = vData
End Property
Public Property Get FileName() As String
FileName = mvarFileName
End Property
Public Property Let BufferSize(ByVal vData As Long)
mvarBufferSize = vData
End Property
Public Property Get BufferSize() As Long
BufferSize = mvarBufferSize
End Property
Public Property Let ChannelNumber(ByVal vData As Integer)
mvarChannelNumber = vData
End Property
Public Property Get ChannelNumber() As Integer
ChannelNumber = mvarChannelNumber
End Property
Public Property Let EndOfFile(ByVal vData As Boolean)
mvarEndOfFile = vData
End Property
Public Property Get EndOfFile() As Boolean
EndOfFile = mvarEndOfFile
End Property
Public Property Let LeftOver(ByVal vData As String)
mvarLeftOver = vData
End Property
Public Property Get LeftOver() As String
LeftOver = mvarLeftOver
End Property
Public Property Let Text(ByVal vData As String)
mvarText = vData
End Property
Public Property Get Text() As String
Text = mvarText
End Property
Public Property Let BytesLeft(ByVal vData As Currency)
mvarBytesLeft = vData
End Property
Public Property Get BytesLeft() As Currency
BytesLeft = mvarBytesLeft
End Property
Function cfOpenFile() As Integer
On Error GoTo Open_File_Error

ChannelNumber = FreeFile

Open FileName For Binary As #ChannelNumber
BytesLeft = LOF(ChannelNumber)

' no error, exit out:
If Err.Number = 0 Then Exit Function

' error of somekind....
Open_File_Error:
cfOpenFile = Err.Number

' reset error handling:
On Error GoTo 0

End Function
Function cfCloseFile()
Close #ChannelNumber
End Function
Private Sub Class_Initialize()
LinesRead = 0
BytesLeft = 0
PreviousLine = vbNullString
Text = vbNullString
NextLine = vbNullString
LeftOver = vbNullString
LineDelimiter = vbNullString
' defaults:
BufferSize = 4096
StripTrailingSpaces = False
StripLeadingSpaces = False
StripNulls = False
NoBlankLines = False
OnlyAlphaNumericCharacters = False
CountOnlyNonBlankLines = False
FixedWidthLineLength = 0
End Sub
Private Sub Class_Terminate()
Call cfCloseFile
End Sub
Public Sub csGetALine()
Static NotFirst As Boolean

' move the last line read into the
' PreviousLine so it isn't lost:
PreviousLine = Text

csGetALine_Start:

If NotFirst = False Then
' load a line into the nextline property
Call csGetNextLine
' set NotFirst to true so this doesn't happen again
NotFirst = True
' now go through this routine the right way:
GoTo csGetALine_Start
Else
' move the next line into the text property
Text = NextLine
' increment the line counter
LinesRead = LinesRead + 1
End If

If (CountOnlyNonBlankLines = True) And _
(Len(Trim$(Text)) = 0) Then
' decrement the line counter for blank lines
' if the user doesn't want to count those
LinesRead = LinesRead - 1
End If

' trim the string based on user settings:
If StripLeadingSpaces = True Then
Text = LTrim$(Text)
End If

If StripTrailingSpaces = True Then
Text = RTrim$(Text)
End If

If OnlyAlphaNumericCharacters = True Then
Text = AlphaNumOnly(Text)
End If

' load the next line into the nextline propery:
Call csGetNextLine

' if text is blank, loop through again if the user
' doesn't want blank lines:
If (NoBlankLines = True And _
Len(Trim$(Text)) = 0) Then
If Not EndOfFile Then
GoTo csGetALine_Start
End If
End If

End Sub
Private Sub csGetNextLine()
Dim intFF As Integer
Dim intX As Integer
Dim Temp As String

' keep the buffer full:
Call LoadBuffer

If FixedWidthLineLength = 0 Then
If LineDelimiter = vbNullString Then
' figure out what the line delimiter is:
Call DetermineLineDelimiter
End If

' see if someone stuck a form feed
' in the middle of the line:
intFF = InStr(LeftOver, vbFormFeed)
intX = InStr(LeftOver, LineDelimiter)

' figure out which is the left most:
If intX > 0 Then
If (intFF < intX) And (intFF > 0) Then
intX = intFF
End If
Else
If intFF > 0 Then
intX = intFF
End If
End If

' trim the string to the leftmost deliminater:
If intX > 0 Then
NextLine = "" & Left$(LeftOver, intX - 1)
If intX = intFF Then
LeftOver = Mid$(LeftOver, intX + 1)
Else
LeftOver = Mid$(LeftOver, _
intX + Len(LineDelimiter))
End If
Else
NextLine = "" & LeftOver
LeftOver = ""
End If
Else
' for Fixed Width files, ignore the delimiters,
' and use the length set by the programmer:
NextLine = Left$(LeftOver, FixedWidthLineLength)
LeftOver = Mid$(LeftOver, FixedWidthLineLength + 1)
End If

End Sub
Private Sub LoadBuffer()
Dim intX As Integer

If Not EndOfFile Then
If Len(LeftOver) < BufferSize Then
intX = BufferSize - Len(LeftOver)
If BytesLeft < intX Then
intX = BytesLeft
End If
End If
If StripNulls = True Then
' it's easier/faster to do this here....
LeftOver = LeftOver & _
NoNulls(Input$(intX, ChannelNumber))
Else
LeftOver = LeftOver & _
Input$(intX, ChannelNumber)
End If
' update the number of bytes left in the file
' we're reading from:
BytesLeft = BytesLeft - intX
End If

' see if we're done:
If (EOF(ChannelNumber)) Or _
(BytesLeft = 0 And _
LeftOver = "" And _
NextLine = "") Then
EndOfFile = True
End If
End Sub
Private Sub DetermineLineDelimiter()
Dim intCRLF As Integer ' standard CrLf
Dim intCR As Integer ' Carridge Return
Dim intLF As Integer ' Line Feed
Dim intX As Integer

'find the leftmost CR,LF or FF:
intCRLF = InStr(LeftOver, vbCrLf)
intLF = InStr(LeftOver, vbLf)
intCR = InStr(LeftOver, vbCr)
intX = Len(LeftOver)

' Use whatever is leftmost as the delimiter!
If (intCRLF < intX) And (intCRLF > 0) Then
LineDelimiter = vbCrLf
intX = intCRLF
End If
If (intLF < intX) And (intLF > 0) Then
LineDelimiter = vbLf
intX = intLF
End If
If (intCR < intX) And (intCR > 0) Then
LineDelimiter = vbCr
intX = intCR
End If
End Sub
Private Function NoNulls(strIn As String) As String
' removes all Chr$(0)'s (ASCII Null's) from
' a string.
Dim intI As Integer
Dim strTemp As String
strTemp = strIn
intI = InStr(strTemp, Chr$(0))
While intI > 0
strTemp = Left$(strTemp, intI - 1) & _
Mid$(strTemp, intI + 1)
intI = InStr(strTemp, Chr$(0))
Wend
NoNulls = strTemp
End Function
Private Function AlphaNumOnly(strIn As String) As String
' removes all but the ASCII Characters on the
' keyboard.
Dim intI As Integer
Dim strTemp As String
strTemp = strIn
While intI < Len(strTemp)
intI = intI + 1
Select Case Asc(Mid$(strTemp, intI, 1))
Case 32 To 126
' do nothing. we want to keep these!
Case Else
' get rid of everything else:
strTemp = Left$(strTemp, intI - 1) & _
Mid$(strTemp, intI + 1)
If intI > 1 Then intI = intI - 1
End Select
Wend
AlphaNumOnly = strTemp
End Function
Public Sub csFindLine(strStringToFind As String, _
Optional bolIgnoreCase As Boolean = True)
' finds a string within a file by reading through
' the file line by line.
Dim intI As Integer

If Text = "" Then csGetALine
Do
If bolIgnoreCase = False Then
' don't care what case (upper/lower) the string is):
intI = InStr(1, Text, strStringToFind, vbBinaryCompare)
Else
intI = InStr(1, Text, strStringToFind, vbTextCompare)
End If
' not found, try the next line:
If intI = 0 Then Call csGetALine
Loop While Not EndOfFile And intI = 0
End Sub
Public Sub csFindInFile(strStringToFind As String, _
Optional bolIgnoreCase As Boolean = True)

'Faster way to find a line that's in a large file,
'but slower returning it back to the program.

Dim intI As Integer
Dim Temp As String

'clear the nextline and text properties,
' since they no longer have value to us:
NextLine = vbNullString
Text = vbNullString

' makesure the buffer is full:
Call LoadBuffer

Do
If bolIgnoreCase = False Then
' don't care what case (upper/lower) the string is):
intI = InStr(1, LeftOver, _
strStringToFind, vbBinaryCompare)
Else
intI = InStr(1, LeftOver, _
strStringToFind, vbTextCompare)
End If
' not found, try the next set of characters:
If intI = 0 Then
' save the right most characters in case we
' only got part of them:
LeftOver = Right$(LeftOver, _
Len(strStringToFind))
' reload the buffer:
Call LoadBuffer
End If
' note: since we're doing some pretty weird things
' here, we can't rely on EndOfFile, so watch the
' BytesLeft property instead to find out if the class
' is at the end of the file.
Loop While BytesLeft > 0 And intI = 0

If intI > 0 Then
' found it!
' put everything that's before what we've searched for
' into the previousline:
Temp = Left$(LeftOver, intI - 1)
LeftOver = Mid$(LeftOver, intI)
csGetALine
If FixedWidthLineLength = 0 Then
' work backwards through temp
'to find the line delimiter:
Do
intI = intI - 1
If Mid$(Temp, intI, Len(LineDelimiter)) = _
LineDelimiter Then Exit Do
Loop While intI > 0 And intI > Len(LineDelimiter)
' move those characters from Temp into
' the front of text to make a complete line:
If intI > 0 Then
Text = Mid$(Temp, intI + Len(LineDelimiter)) _
& Text
' put the rest of temp into the previousline
' property so it's available to the programmer:
PreviousLine = Left$(Temp, _
intI - Len(LineDelimiter))
End If
End If
Else
'The string we're searching for wasn't there!
'Text, NextLine & Leftover no longer have
'value, so clear them out to reduce confusion:
Text = vbNullString
NextLine = vbNullString
LeftOver = vbNullString
End If
End Sub

Please do not feed the trolls.....
 
Thanks PH, I got it to work like a charm. It was a little hairy because my predecessor had created a user defined function named split (genius!) but I created a new .mdb file to handle this task. Now I just need to set it up to trim the .txt from the end of file name before adding it to SQL Table. You the man!

Ed, Thanks for the mod. It doesn't look like it would quite do what I want (return counts for a group of files) but it does have a ton of functions that could come in handy down the road. I just need to find time to read it all ;-)

 
Hi All,

I am running into a problem with this function. I'm adapting it to work in another process, but it either

a.) Runs out of Memory (this is if I open with access 2003 instead of 2000)

b.) Gets to a point, and then says it's unable to read the text stream. Here's the error:

Run-time error '-2147417848 (80010108)': Method 'ReadAll' of object 'ITextStream' failed

Here is the code I am using:

Code:
Public Function RecordCountIBC()

   Dim fso, f, f1, fc, fco, fc1, txs, txstest, trimname
    
    Dim folderspec          As String
    Dim PathandFile         As String
    Dim curdate As String
    
    curdate = Format(Date, "mmddyy")

    
    DoCmd.SetWarnings (WarningsOff)
    folderspec = "G:\Some\Directory\DataFiles\" 'Location ofSource files
    
    
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set f = fso.GetFolder(folderspec)                    'Specify Folder
    Set fc = f.Files
    
    For Each f1 In fc               'for each file in folderspec

If Right(f1.Name, 4) = ".TXT" Then

    Set txs = f1.OpenAsTextStream(1)      'Opens each file as text stream

    txstest = UBound(Split(txs.ReadAll, vbCrLf))         'Reads all lines within file
   
    trimname = Left(f1.Name, Len(f1.Name) - 4)
    
    SQL1 = "Insert Into LoadSnapshot (FileName, FileRC) "
    SQL2 = "Values ('" & trimname & "'," & txstest & ")"
    
   DoCmd.RunSQL SQL1 & SQL2
    
   
   Debug.Print txstest, f1.Name
   
   txs.Close
   
    

    
End If

    Next
DoCmd.SetWarnings (WarningsOn)
End Function

For a little more info, the largest text file in this set is approximately 160 megs and 957,319 rows. Is there a limit to how large a file I can retrieve the count for?

Thanks a lot,

Alex
 
Split function takes a string as an argument. The ReadAll method tries to consume up to 160 megs and squeez it into a string. It might be a problem. Look at the capacity of the string data type in the help file. Moreover, look at the UBound function, it's capacity, if this is Long or Integer. Look at 957,319 and if Ubound can return this value.
 
AlexCuse,
Here is a variation on determining the number of records (lines) in an external file and avoids having to read the entire file into a variable (at least all at the same time).
Code:
Function RecordsInFile_CrLF_Delimited(FileName As String) As Double
On Error GoTo RecordsInFile_CrLF_Delimited_Error
Dim intFile As Integer
Dim strLine As String
intFile = FreeFile
Open FileName For Input As #intFile
Do
  Line Input #intFile, strLine
  RecordsInFile_CrLF_Delimited = RecordsInFile_CrLF_Delimited + 1
Loop Until EOF(intFile)

Clean_Up:
Close #intFile
Exit Function

RecordsInFile_CrLF_Delimited_Error:
RecordsInFile_CrLF_Delimited = -1
Resume Clean_Up
End Function

Hope this helps,
CMP

(GMT-07:00) Mountain Time (US & Canada)
 
Vlad, thanks for getting me on the right track. Caution, thanks for the head start.

This is what I ended up using:

Code:
Public Function RecordCountTxtFiles()

   
    
    Dim folderspec          As String
    Dim PathandFile         As String
    Dim curdate             As String
    Dim IntFile             As Integer
    Dim strLine             As String
    Dim RecCnt              As Long
    Dim fso, f, f1, fc, trimname
    
    
    DoCmd.SetWarnings (WarningsOff) 'When running in Access 2k3 it gives warning each time SQL is run
    folderspec = "G:\Some\Directory\" 'Location ofSource files
    
    
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set f = fso.GetFolder(folderspec)                    'Specify Folder
    Set fc = f.Files
    
    For Each f1 In fc               'for each file in folderspec
    
        If Right(f1.Name, 4) = ".TXT" Then
            RecCnt = 0
            IntFile = FreeFile
            Open folderspec & f1.Name For Input As #IntFile
                Do
                    Line Input #IntFile, strLine
                    RecCnt = RecCnt + 1
        
                Loop Until EOF(IntFile)
    
            trimname = Left(f1.Name, (Len(f1.Name) - 4))
    
    
            SQL1 = "Insert Into LoadSnapshot (FileName, FileRC) "
            SQL2 = "Values ('" & trimname & "'," & RecCnt & ")"
    
            DoCmd.RunSQL SQL1 & SQL2
    
   
            Debug.Print RecCnt, f1.Name
   
            Close #IntFile

    
        End If

    Next
DoCmd.SetWarnings (WarningsOn)
End Function

Thanks for helping me get my head around this. It's going to save me a couple of hours every month (at a time when I need every hour I can get)
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top