批量重命名文件名称小软件

说在前面

先扯会，如果不是Android开发的，要使用本小软件，可以直接到下面正题

在Android开发中，有时会遇到大量文件需要重命名的情况，特别是一些图片文件。有两个同学遇到过这种情况，我暂时还没遇到，但这种情况以后肯定会遇到的。

可以用批处理命令（move，ren）来解决，但要一条一条写命令，写修改后的文件名，还要写原文件名。如果有些修改后的名称直接是a001.txt，a002.txt，a003.txt，……毫无疑问这样有规律的名称，用万能的Excel解决最快了，一个拖拉就搞定。以前也写过类似的批量修改软件，虽然功能不一样，但最核心的原理是一样的。好久没有写VB了，写起来真别扭。用惯了AS（Android Studio），感觉这就是一个天堂，一个地狱。

在现有的情况下，如果文件被引用了，需要重命名，在中，只能一个一个更改（Win：Shift+F6）。但如果文件还没有被引用，需要重命名，那就可以使用本小软件助您一臂之力。

本来要上传到CSDN的资源里，可是一直弹出让我登录。点击“确定”还不行，也关闭不了页面，不知道的还以为是中病毒了。还好咱们都是有经验的人，一个勾选，最后页面显示服务器异常。尝试了好多遍都不行，最后放弃，投向百度云的怀抱

回归正题

下载地址：http://pan.baidu.com/s/1qYGJ3VQ

解压后，里面有一个.xls文件，就是所谓的小软件。另一个是folder文件夹，用于存放需要重命名的文件。

注意：
1. Excel文件和folder文件夹必须在同一目录下
2. 切勿更名此folder文件夹的名称

操作步骤：
【1】 打开Excel，你就能看到华丽的页面出来了

【2】 但要完成功能，需要手动开启宏。一般在上面会弹出此警告，点击“启用内容”即可

【3】 把你的文件放入到folder文件夹中

【4】 点击按钮“获取folder文件夹中的所有文件”
会把folder中所有的文件名显示出来，如步骤1中图片。有时只需要在旧名称上修改一点点即可，为了减少工作量，把新名称和新名称的后缀名也填成了旧名称的

【5】修改新的名称（⊙﹏⊙b后面的执行结果，是等到下一步修改名称后才会出现的，Sorry）

【6】点击“批量修改文件名”，folder文件夹中的文件将改头换面了

OK，完成了。。。

赠送福利

除了这基本的功能外，还有两个额外的功能：

A、除了新名称和其后缀名可以编辑外，其他都禁止编辑，为了防止你的一个不小心。但可以调整宽度，给你更好的视觉查看超长名称

B、新名称中如果有相同的（因为你没有看到过在哪个文件夹中存在两个一样的文件名称），将报红色警告，给您温馨的提示。

年终奖

Android开发过程中，如果没有大神们的开源项目，大家都不知道在哪里摸爬滚打。支持OpenSource

Option Explicit

‘************************************************
‘获取folder文件夹中所有的文件
‘************************************************
Sub GetFiles_Click()
    Dim myPath$, myFile$, eachwirexls As Workbook
    Dim num%
    num = 0

    ‘获取本软件目录下的folder文件路径
    myPath = ThisWorkbook.Path & "/folder/"

    On Error GoTo Error_handle
    Call unlockSheet ‘解锁
    With Application.ThisWorkbook.ActiveSheet
        ‘ 清除所有单元格区域
        Range("A3:F65536") = ""

        ‘获取路径中所有的文件
        myFile = Dir(myPath, vbNormal)
        Do Until Len(myFile) = 0
            num = num + 1
            Cells(num + 2, 1) = num
            ‘Debug.Print myFile ‘立即窗口测试打印结果
            Dim temp As Variant
            Dim results() As String
            temp = splitSuffix(myFile)
            results() = temp
            Cells(num + 2, 2) = results(1)
            Cells(num + 2, 4) = results(1)
            Cells(num + 2, 3) = results(2)
            Cells(num + 2, 5) = results(2)
            myFile = Dir
        Loop
        ‘Debug.Print myFile

    End With
    Call lockSheet
    MsgBox "共查找到 " & num & " 个文件"
    Exit Sub

Error_handle:
    Call lockSheet
    MsgBox "查找文件失败，请检查"

End Sub

‘************************************************
‘获取文件名称中的后缀名
‘************************************************
Private Function splitSuffix(fileName As String) As Variant
    Dim sum%, location%, i%
    Dim results(2) As String
    results(1) = fileName
    results(2) = ""
    sum = Len(fileName)
    location = 0
    For i = sum To 1 Step -1
        If Mid(fileName, i, 1) = "." Then
            location = i
            GoTo End_Handle
        End If
    Next

End_Handle:
    If location <> 0 Then
        results(1) = Left(fileName, location - 1) ‘文件名
        results(2) = Right(fileName, sum - location + 1) ‘文件后缀名
    End If
    splitSuffix = results
End Function


‘************************************************
‘批量修改文件名称
‘************************************************
Sub Rename_Click()
    Dim myPath$, i%
    myPath = ThisWorkbook.Path & "/folder/"
    Call unlockSheet
    With Application.ThisWorkbook.ActiveSheet
        .Unprotect
        For i = 3 To [A65536].End(3).Row
            Name myPath & Trim(Cells(i, 2)) & Trim(Cells(i, 3)) As myPath & Trim(Cells(i, 4)) & Trim(Cells(i, 5))
            Cells(i, 6) = "OK"
        Next
    End With
    Call lockSheet
    MsgBox "批量修改完成"
End Sub

‘************************************************
‘工作表解锁
‘************************************************
Private Function unlockSheet()
Application.ThisWorkbook.ActiveSheet.Unprotect
End Function

‘************************************************
‘工作表上锁
‘************************************************
Private Sub lockSheet()
Application.ThisWorkbook.ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
        False, AllowFormattingColumns:=True, AllowDeletingRows:=True, _
        AllowFiltering:=True
End Sub