Excel的VBA输入超出文件尾?怎么办?

问题遇到的现象和发生背景

输入20多个文本文档的时候,提示超出文件尾

问题相关代码,请勿粘贴截图

代码如下:

Sub 导入txt文件名及文本内容()

Dim t As Date

Dim r As Long

Dim Fso As Object

Dim myFile As Object

Dim mySheet As Worksheet

Dim txtFolder As Object

t = Timer

r = 2

Set txtFolder = CreateObject("Shell.Application").BrowseForFolder(0, "请选择txt所在文件夹:", 0, ThisWorkbook.Path)

If txtFolder Is Nothing Then Exit Sub

Set Fso = CreateObject("Scripting.FileSystemObject")

Set mySheet = ThisWorkbook.Sheets("sheet1")

Application.ScreenUpdating = False

mySheet.Cells.Clear

mySheet.[A1:B1].Value = Array("文件名", "文本内容")

For Each myFile In Fso.getfolder(txtFolder.Self.Path).Files

If Fso.GetExtensionName(myFile) = "txt" Then

mySheet.Cells(r, 1).Value = myFile.Name

mySheet.Cells(r, 2).Value = Fso.OpenTextFile(myFile).ReadAll '写入文本

r = r + 1

End If

Next myFile

Application.ScreenUpdating = True

Set mySheet = Nothing

Set Fso = Nothing

Set txtFolder = Nothing

MsgBox "结束,共运行" & Format((Timer - t), "0.0") & "秒"

End Sub

运行结果及报错内容

运行错误62,提示超出文件尾

我的解答思路和尝试过的方法

我把多有文本文档都设置成了ANSI编码,因为UTF8乱码

我想要达到的结果

我有一万个文档要输入。
Excel两列一列是文本文档的名字,一列是文本文档的内容。
上述代码只能输入20多个文档,输入多了就提示有错误

测试了题主的代码没问题。text文件单个700kb左右,写了43个一样的

img