把当前文件夹中所有txt读入到excel中

Sub 读取数据()
'把当前文件夹下所有的txt读入到excel文件中
'每个txt对应一个sheet,txt的名称与sheet名称一致
'txt的文本每行用tab分割
Dim MyFile As String
Dim s As Integer
Dim count As Integer
Dim Arr(100) As String
Dim FileObj As Object


tmpath = ActiveWorkbook.Path
MyFile = Dir(tmpath & "\" & "*.txt")
'MyFile = Dir("F:\test\index\" & "*.txt")
count = count + 1

'遍历所有所有txt文件,文件名存入Arr
Arr(count) = MyFile
Do While MyFile <> ""
    MyFile = Dir
    If MyFile = "" Then
        Exit Do
    End If
    count = count + 1
    Arr(count) = MyFile
Loop

'遍历Arr,存储相应的txt
For i = 1 To count
    Worksheets.Add
    ActiveSheet.Name = Arr(i)
    
    Dim objStream, strData
    Set objStream = CreateObject("ADODB.Stream")
    ' utf-8 编码读入
    objStream.Charset = "utf-8"
    objStream.Open
    fname = ActiveWorkbook.Path & "\" & Arr(i)
    objStream.LoadFromFile (fname)
    ' 行分隔符
    objStream.LineSeparator = 10
    
    num = 1
    Do Until objStream.EOS
        strLine = objStream.ReadText(-2)
        Text = Split(strLine, Chr(9))
        For j = 1 To UBound(Text)
            ActiveSheet.Cells(num, j) = Text(j - 1)
        Next
    num = num + 1
    Loop
    'strData = objStream.ReadText()
Next

End Sub