使用vb写入文件名和文件内容，结果文件内容写入乱码

菜鸟先飞吗

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") '引用fso对象
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
这是我在知乎找到的一段代码，我手贱提前把txt文件的代码改成utf8的，结果导入以后都是乱码。请问可以修改以上的代码，让代码支持utf8的格式吗？

lss001

Sub 导入txt文件名及文本内容()
    Dim t As Date, r As Long, Fso As Object, myFile As Object
    Dim mySheet As Worksheet, 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") '引用fso对象
    Set mySheet = ThisWorkbook.Sheets("sheet1") '设置汇总表
    Application.ScreenUpdating = False '关闭屏幕刷新
    '__________汇总表初始化______________________________
    mySheet.Cells.Clear
    mySheet.[A1:B1].Value = Array("文件名", "文本内容")
    '___________________________________________________
    Set ad = CreateObject("Adodb.Stream")
    For Each myFile In Fso.getfolder(txtFolder.Self.Path).Files
        If Fso.GetExtensionName(myFile) = "txt" Then '判断拓展名
            mySheet.Cells(r, 1).Value = myFile.Name '写入文件名
            With ad
                .Charset = "utf-8"
                .Open
                .LoadFromFile myFile
                st = .ReadText()
                .Close
            End With
            mySheet.Cells(r, 2).Value = st '写入文本
            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