EXCEl批量获取文件名

批量获取某一个文件夹下边的文件名，并写入到EXCEl的表中，并根据表格的字段来命名原文件。

Sub FSO批量获取文件名()
Cells = ""
Dim sfso
Dim myPath As String
Dim Sh As Object
Dim Folder As Object
Application.ScreenUpdating = False
On Error Resume Next
Set sfso = CreateObject("Scripting.FileSystemObject")
Set Sh = CreateObject("shell.application")
Set Folder = Sh.BrowseForFolder(0, "", 0, "")
If Not Folder Is Nothing Then
  myPath = Folder.Items.Item.Path
End If
Application.ScreenUpdating = True
Cells(1, 1) = "旧版名称"
Cells(1, 2) = "文件类型"
Cells(1, 3) = "所在位置"
Cells(1, 4) = "新版名称"
Call FSO直接提取文件名(myPath & "\")
End Sub


Sub FSO直接提取文件名(myPath As String)
    Dim i As Long
    Dim myTxt As String
    i = Range("A1048576").End(xlUp).Row
    myTxt = Dir(myPath, 31)
    Do While myTxt <> ""
    On Error Resume Next
        If myTxt <> ThisWorkbook.Name An