|
- Sub 指量更名()
- Dim name$, path$, file$, msg$
- name = Application.InputBox("请输入新文件前缀名:", "友情提示", "2013", , , , , 2)
- If name = "False" Then MsgBox "请输入有效的前缀名并点击确定": Exit Sub
- path = ThisWorkbook.path & Application.PathSeparator
- file = Dir(path & "*.xls", vbNormal)
- On Error Resume Next
- Do While Len(file) > 0
- If file <> ThisWorkbook.name Then
- Name path & file As path & name & "-" & file
- If Err.Number <> 0 Then
- msg = msg & file & "重命名失败" & vbCr
- Err.Clear
- End If
- End If
- file = Dir
- Loop
- If Len(msg) = 0 Then
- MsgBox "批量重命名完成"
- Else
- MsgBox msg
- End If
- End Sub
复制代码 |
|