如何确保在使用 FSO 时只打开文本文件 - VBA

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

目前有一个使用 FSO 的工作脚本,但它也会在我的工作目录中打开 .xlsm 文件我只想打开 .txt 文件。

我发现这段代码应该可以工作,但是我不知道如何将它应用到我的情况中:

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

我的代码(有效,但也打开 .xlsm 文件,我不希望它这样做):

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

我不知道 fso 是否支持 GetFolder 的重载方法,您可以在其中指定模式。如果是,请使用它,即 GetFolder(Path, "*.txt")。如果没有,您能否不只是添加一个简单的条件来检查 'for each' 循环中的文件扩展名,并且只处理以 '.txt' 结尾的文件。

更新:

试试这个:

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

我已经测试过了,它按预期工作。