VB批量修改excel文件名

Sub 批量命名0()

Application.ScreenUpdating = False

    Dim i&, j&, m, n, l$, k, s, path, oname, nname, fs, t$

    Application.ScreenUpdating = False

  With Application.FileDialog(msoFileDialogOpen)

   .AllowMultiSelect = True '允许多选

   .Show '打开文件对话框

 '  获取文件名称

   For i = 1 To .SelectedItems.Count

       l = .SelectedItems(i)

       m = Len(l) - Len(WorksheetFunction.Substitute(l, "\", ""))

       k = WorksheetFunction.Substitute(l, "\", "/", m)

       n = WorksheetFunction.Find("/", k)

       Cells(i, 1) = Mid(l, n + 1, Len(l))

  '  获取文件路径

  If i = .SelectedItems.Count Then path = Mid(l, 1, Len(l) - Len(Cells(i, 1)))

   Next i

  End With

  '  获取新名字 按自然数编号

  t = "0000"

  If i <= 1000 Then t = "000"

  If i <= 100 Then t = "00"

 ' If i <= 10 Then t = "0"

     For s = 1 To i - 1

       l = Cells(s, 1).Value

       m = Len(l) - Len(WorksheetFunction.Substitute(l, ".", ""))

       k = WorksheetFunction.Substitute(l, ".", "/", m)

       n = WorksheetFunction.Find("/", k)

       Cells(s, 2) = WorksheetFunction.Text(s, t) & Mid(l, n, Len(l))

   Next

  Set fs = CreateObject("Scripting.FileSystemObject")

  For s = 1 To i - 1

  oname = path & Cells(s, 1)

  If fs.fileexists(oname) Then

  nname = path & Cells(s, 2)

  Name oname As nname

  End If

  Next

  Application.ScreenUpdating = True

End Sub