心得(2)：如何利用VBA一键更改多个excel文件为指定的名称

问题：如何一键更改相同目录下的所有excel文件的名称，改为这个excel文件名内的每个单元格的内容，如我这个因为是要统计所有比赛队伍的信息，因为大部分人的excel文件名都不规范，这样如果有人想更新文件就得在文件夹里一个一个找很麻烦，就直接把每个队伍的文件命名为他的比赛项目名，这样在一定程度上就具有唯一性

解决：首先把所有要整合的excel文件放在一个路径不含有中文名的目录下，然后新建一个excel文件右键sheet点击查看代码，这时候你的画面上会出现一个编辑器，你这这上面利用VBA编写语言，最后点击F5直接运行即可

常规解决方案：
打开文件，复制项目名，关闭文件，重命名

利用VBA一键修改：

1. 得到全是英文目录下的一个文件名
   
2. 打开这个文件
   
3. 得到这个文件对应的项目名
   
4. 推出并关闭这个文件
   
5. 重命名这个文件
   
6. 因为这个项目名可能会出现很多windows的非法字符所以要利用replace函数出去一下

7. 而且还会出现许多不知名的错误，比如说重名，没写项目名等，这样就要使用的VBA的错误处理机制

源码如下：

Sub 批量改名()
    Dim mypath As String, myname As String, awbname As String, arg As String
    Dim wbcount As Integer, i As Integer
    Dim olds As String, news As String
    
    
    '关闭excel的刷新
    Application.ScreenUpdating = False

    '禁止弹出对话框
    Application.DisplayAlerts = False

    '得到本文件的相对地址
    mypath = ActiveWorkbook.Path
    
    '当前工作的excel的文件名
    awbname = ActiveWorkbook.Name

    '任意打开文件夹下的某一个文件
    wbcount = 0
    myname = Dir(mypath & "\" & "*.xlsx")
    
    '定义一个变量为项目的名称（文件中的命名）
    arg = ""

    '如果当前的文件名为空的字符串（""）表示已经没有更多的文件了跳出循环
    Do While myname <> ""
        If myname <> awbname Then
            '打开当前的文件夹
            Set wb = Workbooks.Open(mypath & "\" & myname)

            '得到这个文件的项目名的名称
            arg = wb.Sheets(1).Range("B5")

            wbcount = wbcount + 1
        
            '关闭文件
            wb.Close False
            
            '除去arg中命名规则不允许的字符
            arg = Replace(arg, "\", "")
            arg = Replace(arg, " ", "")
            arg = Replace(arg, "/", "")
            arg = Replace(arg, "?", "")
            arg = Replace(arg, "<", "")
            arg = Replace(arg, ">", "")
            arg = Replace(arg, "'", "")
            arg = Replace(arg, ":", "")
            arg = Replace(arg, "*", "")
            arg = Replace(arg, """", "")
            arg = Replace(arg, ".", "")
            arg = Replace(arg, "|", "")
            arg = Replace(arg, Chr(10), "")
            arg = Replace(arg, Chr(32), "")

            
            olds = mypath & "\" & myname
            news = mypath & "\" & arg & ".xlsx"

            '将这个文件的名称换成这个项目名
            On Error GoTo MyErr '错误导向
            Name olds As news

        End If
        '随机打开本文件夹的另一个文件
        myname = Dir
    Loop

'结束程序并且恢复之前的操作
MsgBox "一共更改了 " & wbcount & " 个文件"
Application.ScreenUpdating = True
Application.DisplayAlerts = True

'因为这个VBA语言到最后会运行错误标志的内容所以在结束后要让他失效
olds = ""

'错误标志
MyErr:
    If olds = "" Then
        
    Else
        arg = arg & wbcount
        news = mypath & "\" & arg & ".xlsx"
        Name olds As news
        Resume Next
    End If
    
    
End Sub