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

eryksd

Board Regular
Joined
Jan 17, 2016
Messages
51
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:


Code:
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)

Code:
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

MrExcel MVP
Joined
Mar 18, 2010
Messages
8,787
Not tested with your code, but you should be able to do that like this...

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

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

        Loop
    End If
Next file
 
Last edited:

Cindy Ellis

MrExcel MVP
Joined
Jun 9, 2006
Messages
1,802
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:
Code:
 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

Board Regular
Joined
Jan 17, 2016
Messages
51
Not tested with your code, but you should be able to do that like this...

Code:
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

Board Regular
Joined
Jan 17, 2016
Messages
51
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:
Code:
 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
Code:
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:

Code:
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
 
Last edited:

GTO

MrExcel MVP
Joined
Dec 9, 2008
Messages
6,154
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:

Rich (BB code):
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
 

Forum statistics

Threads
1,082,298
Messages
5,364,377
Members
400,795
Latest member
Vercas

Some videos you may like

This Week's Hot Topics

  • populate from drop list with multiple tables
    Hi All, i have a drop list that displays data, what i want is when i select one of those from the list to populate text from different tables on...
  • Find list of words from sheet2 in sheet1 before a comma and extract text vba
    Hi Friends, Trying to find the solution on my task. But did not find suitable one to the need. Here is my query and sample file with details...
  • Dynamic Formula entry - VBA code sought
    Hello, really hope one of you experts can help with this - i've spent hours on this and getting no-where. .I have a set of data (more rows than...
  • Listbox Header
    Have a named range called "AccidentsHeader" Within my code I have: [CODE]Private Sub CommandButton1_Click() ListBox1.RowSource =...
  • Complex Heat Map using conditional formatting
    Good day excel world. I have a concern. Below link have a list of countries that carries each country unique data. [URL...
  • Conditional formatting
    Hi good morning, hope you can help me please, I have cells P4:P54 and if this cell is equal to 1 then i want row O to say "Fully Utilised" and to...
Top