說在前面

先扯會，如果不是Android開發的，要使用本小軟體，可以直接到下面正題

在Android開發中，有時會遇到大量檔案需要重新命名的情況，特別是一些圖片檔案。有兩個同學遇到過這種情況，我暫時還沒遇到，但這種情況以後肯定會遇到的。

可以用批處理命令（move，ren）來解決，但要一條一條寫命令，寫修改後的檔名，還要寫原檔名。如果有些修改後的名稱直接是a001.txt，a002.txt，a003.txt，……毫無疑問這樣有規律的名稱，用萬能的Excel解決最快了，一個拖拉就搞定。以前也寫過類似的批量修改軟體，雖然功能不一樣，但最核心的原理是一樣的。好久沒有寫VB了，寫起來真彆扭。用慣了AS（Android Studio），感覺這就是一個天堂，一個地獄。

在現有的情況下，如果檔案被引用了，需要重新命名，在中，只能一個一個更改（Win：Shift+F6）。但如果檔案還沒有被引用，需要重新命名，那就可以使用本小軟體助您一臂之力。

本來要上傳到CSDN的資源裡，可是一直彈出讓我登入。點選“確定”還不行，也關閉不了頁面，不知道的還以為是中病毒了。還好咱們都是有經驗的人，一個勾選，最後頁面顯示伺服器異常。嘗試了好多遍都不行，最後放棄，投向百度雲的懷抱

迴歸正題

解壓後，裡面有一個.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