How Can I Only Open Text (.txt) Files When Working With FSO? (FileSystemObject)

[eryksd]

Currently have a working script that uses FSO, but it also opens .xlsm files within my working directory. I would like to to only open .txt files.
I found this code that should work, however I can't figure out how to apply it to my situation:

Sub test()
    ' Loop thru all files in the folder
    folder = ActiveWorkbook.path

    path = folder & "\*.txt"

    Filename = Dir(path)

    Do While Filename <> ""
       'insert other functions here
    Loop

End Sub

My Code: (Works, but also opens .xlsm files, which messes up the array initialization)

Option Explicit

Sub Initialize_barcode_lookup_Array_test()

 Dim fso As FileSystemObject
 Dim folder As String, path As String, count_txt_files As Long, Filename As String
 Dim folder2 As folder
 Dim file As file
 Dim FileText As TextStream
 Dim TextLine As String
 Dim Items() As String
 Dim ShippingPlanArray() As String
 Dim i As Long, j As Long, k As Long
 Dim cl As Range
 Dim fName
 Dim row As Long, column As Long

 Dim shipping_plan As Long      'Number of shipping plans text files imported
 Dim barcode_Lookup() As String
 Dim lastRow As Long
 Dim longest_lastRow As Long
 Dim counter As Long
 Dim FNSKU_Input As String

'<<<< Creating FSO Object >>>>>
    'Define longest_lastRow
    longest_lastRow = 0

    'Define i (References the text file open)
    i = 0

    ' Get a FileSystem object
    Set fso = New FileSystemObject

    ' get the directory you want
    Set folder2 = fso.GetFolder(ActiveWorkbook.path)

    ' Loop only while the files being opened are .txt files:

    For Each file In folder2.Files

        row = 0
        column = 0

        Set FileText = file.OpenAsTextStream(ForReading)
        Do Until FileText.AtEndOfStream

            fName = FileText.ReadLine
            'Parse data by tabs (text-tab delimited) into Items() array
            Items() = Split(fName, vbTab)

                ' Redimension Preserve the ShippingPlanArray()
                ' NOTE: You can only Redimension preserve the last dimension of a multi-dimensional array
                ' (In this case: row)
                ReDim Preserve ShippingPlanArray(9, row)

                'Read Data into an Array Variable
                For column = LBound(Items) To UBound(Items)
                'MsgBox Items(column)
                ShippingPlanArray(column, row) = Items(column)
                Next column

            row = row + 1
        Loop

    Next file



End Sub

Any help would be greatly appreciated

 

[Jerry Sullivan]

Not tested with your code, but you should be able to do that like this...

For Each file In folder2.Files
    If UCase(fso.GetExtensionName(file.Name)) = "TXT" Then
        row = 0

        '... your code continues       
        '...        
        '...        

        Loop
    End If
Next file

 

[Cindy Ellis]

Do you need to open the file as a text stream for a particular reason? Or is that just the code that you found? You could open the file as a text file using code similar to the following, where "Nextfile" is a variable assigned using dir() or any other means you choose to get the next file in the directory:

 Workbooks.OpenText FileName:=NextFile, _
        StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
        xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True

Once it's open in Excel, you could read each row into an array if that's the structure you need for the rest of your analysis.
(I know this doesn't actually answer your question...it looks like Jerry has already done that. This is just for your consideration for the rest of your code.)
Hope that helps,

 

[eryksd]

Not tested with your code, but you should be able to do that like this...

For Each file In folder2.Files
    If UCase(fso.GetExtensionName(file.Name)) = "TXT" Then
        row = 0

        '... your code continues       
        '...        
        '...        

        Loop
    End If
Next file

Thank you Jerry!

 

[eryksd]

Do you need to open the file as a text stream for a particular reason? Or is that just the code that you found? You could open the file as a text file using code similar to the following, where "Nextfile" is a variable assigned using dir() or any other means you choose to get the next file in the directory:

 Workbooks.OpenText FileName:=NextFile, _
        StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
        xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True

Once it's open in Excel, you could read each row into an array if that's the structure you need for the rest of your analysis.
(I know this doesn't actually answer your question...it looks like Jerry has already done that. This is just for your consideration for the rest of your code.)
Hope that helps,

Just the code I found, my first foray into opening text files.

In theory my code is working, but now something weird is happening: For the 4 text files I'm loading, 1 of them seems to get all of it's contents read by

Do Until FileText.AtEndOfStream

,
but the other 3 all get cut off at the same point: Row 10.

Maybe there's a better way to do it, but not sure. Here's the code I have so far:

Option Explicit

Sub Initialize_barcode_lookup_Array_v3()


 Dim fso As FileSystemObject
 Dim folder As String, path As String, count_txt_files As Long, FileName As String
 Dim folder2 As folder
 Dim file As file
 Dim FileText As TextStream
 Dim TextLine As String
 Dim Items() As String
 Dim ShippingPlanArray() As String
 Dim i As Long, j As Long, k As Long
 Dim cl As Range
 Dim fName
 Dim row As Long, column As Long
 
 Dim shipping_plan As Long      'Number of shipping plans text files imported
 Dim barcode_Lookup() As String
 Dim lastRow As Long
 Dim longest_lastRow As Long
 Dim counter As Long
 Dim FNSKU_Input As String
 Dim sht As Worksheet
 Dim x As Long, y As Long, z As Long


'<<<< Creating FSO Object >>>>>
    'Define longest_lastRow
    longest_lastRow = 0
    
    'Define i (References the text file open)
    i = 0
    
    
    ' Get a FileSystem object
    Set fso = New FileSystemObject


    ' get the directory you want
    Set folder2 = fso.GetFolder(ActiveWorkbook.path)
    
    ' Loop only while the files being opened are .txt files:


    For Each file In folder2.Files
    '<<<<< NEW CODE >>>>
        Dim extension As String
        extension = LCase(Mid$(file, InStrRev(file, ".")))
        If extension = ".txt" Then
            'MsgBox file
        Else
            GoTo NextPart
        End If
    '<<<<< /NEW CODE >>>>
        row = 0
        column = 0


        Set FileText = file.OpenAsTextStream(ForReading)
        Do Until FileText.AtEndOfStream
            
            fName = FileText.ReadLine
            'Parse data by tabs (text-tab delimited) into Items() array
            Items() = Split(fName, vbTab)
            
                ' Redimension Preserve the ShippingPlanArray()
                ' NOTE: You can only Redimension preserve the last dimension of a multi-dimensional array
                ' (In this case: row)
                ReDim Preserve ShippingPlanArray(9, row)
                
                'Read Data into an Array Variable
                For column = LBound(Items) To UBound(Items)
                'MsgBox Items(column)
                ShippingPlanArray(column, row) = Items(column)
                Next column
            If row > longest_lastRow Then longest_lastRow = row
            row = row + 1
        Loop
        
        ' Initialize barcode_Lookup() array
        ' First variable initialized to 50, as I don't think we'll ever have more than 100 FBA Warehouses to ship to
        ReDim Preserve barcode_Lookup(100, 9, row - 1)
        
        For j = 0 To (column - 1)
            For k = 0 To (row - 1)
                barcode_Lookup(i, j, k) = ShippingPlanArray(j, k)
                'MsgBox barcode_Lookup(i, j, k)
            Next k
        Next j
        ' Add 1 to i, so you can initialize the following dimension of barcode_Lookup() array
        i = i + 1
    Next file
        
NextPart:
    'MsgBox barcode_Lookup(0, 0, 0)
    'MsgBox barcode_Lookup(0, 3, 9)
    'MsgBox barcode_Lookup(0, 1, 9)
    'MsgBox barcode_Lookup(1, 1, 9)
    'MsgBox barcode_Lookup(2, 1, 9)
    'MsgBox barcode_Lookup(3, 1, 9)
    
    ' Code to Take Scanned FNKSU's, and search through Current Shipping Plans, _
    ' and subtract '1' from the 'Shipped' count, until there is no inventory left _
    ' to ship.
    
    ' Initialize 'counter', which will be a sum of all the 'Shipped' variables, across all 'i' files.
    ' We'll use the 'counter' variable to know when we've finally scanned in all of our inventory
    
    'MsgBox i
    For i = 0 To (i - 1)                                    ' file
    MsgBox barcode_Lookup(i, 1, 1)
            For k = 9 To longest_lastRow                    ' row
                'MsgBox barcode_Lookup(i, 1, k)
                'counter = counter + Val(barcode_Lookup(i, 9, k))
                'MsgBox "Row: " & k
            Next k
    Next i
    
    'Output array barcode_Lookup() into Sheets 1 through 4 for testing
    Set sht = Sheets("Sheet1")
    sht.Activate
    ReDim Preserve barcode_Lookup(100, 9, longest_lastRow - 1)
    z = 0
    For x = 0 To 9
        For y = 0 To (longest_lastRow - 1)
        MsgBox barcode_Lookup(0, x, y)
            'sht.Cells(y, x).Value = barcode_Lookup(0, x, y)
        Next y
    Next x
    
    Set sht = Sheets("Sheet2")
        
End Sub

Sample Files:

Shipment Plan 1
Shipment Plan 2
Shipment Plan 3
Shipment Plan 4

 

[GTO]

Greetings,

I do not know why .AtEndOfStream would seem to fail. Given that we are likely to find a non-textfile, I couldn't easily test your current code, but am curious if you may be calling this Sub from another procedure. IF that is the case, might you have some error handling (such as Resume Next) in place? Just a blind (or blond) stab.

Anyways, an easy test might be to see if you get different results with:

Option Explicit
'
Sub example()
Dim FSO As Scripting.FileSystemObject
Dim fsoFiles As Scripting.Files
Dim fsoFile As Scripting.File
'
Dim lFileNumber As Long
Dim sLineText As String
'
  Set FSO = New Scripting.FileSystemObject
  Set fsoFiles = FSO.GetFolder("[YOUR PATH HERE]").Files
'
  For Each fsoFile In fsoFiles
    If FSO.GetExtensionName(fsoFile.Path) = "txt" Then
      lFileNumber = FreeFile
      Open fsoFile.Path For Input As #lFileNumber
      Do While Not EOF(lFileNumber)
        Line Input #lFileNumber, sLineText
        Debug.Print sLineText
      Loop
      Close #lFileNumber
    End If
  Next
'
End Sub

Hope that helps,

Mark