Search code examples
arraysvbaexcelfso

How Can I Make Sure I Only Open Text Files When Working With FSO - VBA


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 I don't want it to do):

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

Solution

  • I don't know if fso support an overloaded method for GetFolder where you can specify the pattern. If it does, use that i.e. GetFolder(Path, "*.txt"). If it doesn't, can you not just add a simple condition to check the file extension in your 'for each' loop and only process the ones that ends in '.txt'.

    Update:

    Try this:

    For Each file In folder2.Files
        Dim extension As String
        extension = LCase(Mid$(file, InStrRev(file, ".")))
        If extension = ".txt" Then
            Debug.Print "TEST"
        End If
    Next
    

    I've tested it and it works as expected.