Sub GetFiles()

? ? Dim strPath As String, strFileName As String, k As Long

? ? With Application.FileDialog(msoFileDialogFolderPicker)

? ? ? ? If .Show Then strPath = .SelectedItems(1) Else: Exit Sub

? ? ? ? '獲取用戶(hù)選擇的文件夾的路徑，如果未選取，則退出程序

? ? End With

? ? If Right(strPath, 1) <> "\" Then strPath = strPath & "\"

? ? Application.ScreenUpdating = False

? ? Range("a:b").Clear: k = 1

? ? '清除A:B列的所有

? ? Cells(1, 1) = "舊文件名": Cells(1, 2) = "新文件名"

? ? strFileName = Dir(strPath & "*.xls*")

? ? Do While strFileName <> ""

? ? ? ? k = k + 1

? ? ? ? Cells(k, 1) = strPath & strFileName

? ? ? ? strFileName = Dir

? ? Loop

? ? Application.DisplayAlerts = True

End Sub

Sub ChangeFileName()

? ? Dim r, i As Long

? ? r = Range("a1").CurrentRegion '數(shù)據(jù)裝入數(shù)組

? ? For i = 2 To UBound(r)

? ? '標(biāo)題行不要，從數(shù)組第二行開(kāi)始遍歷

? ? ? ? Name r(i, 1) As r(i, 2) 'Name語(yǔ)句重命名

? ? Next

? ? MsgBox "更名完成。"

End Sub