說在前面
先扯會，如果不是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