批量获取某一个文件夹下边的文件名,并写入到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