工作簿批量改名

Sub 工作簿批量改名1()
    Dim oldName As String, newName As String, fileName
    Application.ScreenUpdating = False
    With Application.FileDialog(msoFileDialogFilePicker)
        If .Show = -1 Then
            For i = 1 To .SelectedItems.Count
                Workbooks.Open .SelectedItems(i)
                pathn = Application.ActiveWorkbook.Path
                oldName = .SelectedItems(i)
                new_wbname = 新的工作簿名称(oldName)
                newName = pathn & "\" & new_wbname & ".xls"
                ActiveWorkbook.Close True
                Name oldName As newName
            Next
        End If
    End With
    Application.ScreenUpdating = True
    MsgBox "OK"
End Sub

Function 新的工作簿名称(p)
    With GetObject(p)
        wbname = .Sheets("往来对账").[b2]
    End With
    新的工作簿名称 = wbname
End Function