[求助]恢复了一大堆的DOC文件,恢复后文件名分别变成按顺序SH001...SH786,如何将文档

能

请参考：
Option Explicit

Sub Example()
Dim MyDialog As FileDialog, vrtSelectedItem As Variant
Dim myArray() As String, OldName As String, thisPath As String
Dim NewName As String
' On Error Resume Next
'定义一个文件夹选取对话框
Set MyDialog = Application.FileDialog(msoFileDialogFilePicker)
With MyDialog
.Filters.Clear '清除所有文件筛选器中的项目
.Filters.Add "所有 WORD 文件", "*.doc", 1 '增加筛选器的项目为所有WORD文件
.AllowMultiSelect = True '允许多项选择
If .Show = -1 Then '确定
thisPath = .InitialFileName
For Each vrtSelectedItem In .SelectedItems '在所有选取项目中循环
NewName = GetFileTitle(thisPath, vrtSelectedItem)
If NewName <> "" Then
Name vrtSelectedItem As thisPath & NewName & ".doc"
End If
Next vrtSelectedItem
End If
End With
End Sub
Function GetFileTitle(apath, strFl) As String
'请在VBE/工具/引用中勾选对于MICROSOFT SHELL CONTROLS AND AUTOMATION
Dim shl As Shell32.Shell
Dim shfd As Shell32.Folder
Dim Flname As String
Set shl = New Shell
Set shfd = shl.NameSpace(apath)
Flname = VBA.Replace(strFl, apath, "")
GetFileTitle = shfd.GetDetailsOf(shfd.Items.Item(Flname), 10)
End Function

但如何能按文件名保存出来呢？

调出标题后能怎么样呢!!??还有这个是不是对EXCEL文件也能有效呢!!

也紧急求助一下啊!我的好多EXCEL的文件名也自动变掉了啊!怎么才能改过来啊!!