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

时间:2016-03-15 04:10:35

标签: arrays vba excel-vba multiple-files fso

目前有一个使用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

我的代码(Works,但也打开.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

1 个答案:

答案 0 :(得分:1)

我不知道fso是否支持GetFolder的重载方法,您可以在其中指定模式。如果是,请使用它,即GetFolder(Path,&#34; * .txt&#34;)。如果它没有,您是否可以添加一个简单的条件来检查您的“&#39;循环并仅处理以&#39; .txt&#39;。

结尾的那些

<强>更新

试试这个:

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

我已经对它进行了测试,并且按预期工作。