如何确保在使用 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
我已经测试过了,它按预期工作。
目前有一个使用 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
我已经测试过了,它按预期工作。