问题遇到的现象和发生背景
输入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多个文档,输入多了就提示有错误