標題: [分享] 小工具-批次改檔名 [打印本頁]

---

作者: n7822123    時間: 2015-11-30 01:42     標題: 小工具-批次改檔名

本帖最後由 n7822123 於 2015-11-30 01:45 編輯

小弟在公司常常會大量複製檔案再更改檔名，所以做了這個小工具
我想應該不只我會用到，分享給大家
裡面有範例檔案與兩個excel檔，2003(.xls)與2007(.xlsm)
我是用2007做的，降存為2003讓2003版本的人也可使用。
使用方法如圖，只能更改與excel檔案同路徑的檔案
應該很易懂。

[attach]22662[/attach]
[attach]22663[/attach]

[attach]22665[/attach]

---

作者: n7822123    時間: 2015-11-30 02:19

回復 1# n7822123


發現程式碼有點小瑕疵，如果改的檔案也是excel檔，可能改不完全就跳出迴圈
做了以下更動，重新附上檔案。

Do
  If myFile = "" Then Exit Do
  If myFile = ThisWorkbook.Name Then GoTo 下一個檔案
  舊檔名 = myPath & "\" & myFile
  新檔名 = Replace(myFile, 要替換, 替換為)
  新檔名 = myPath & "\" & 新檔名
  Name 舊檔名 As 新檔名

下一個檔案:
  myFile = Dir
Loop

[attach]22666[/attach]

---

作者: GBKEE    時間: 2015-11-30 06:05

回復 2# n7822123

試試看

1. Option Explicit
   
2. Sub 更改檔名()
   
3.     Dim 要替換 As String
   
4.     Dim 替換為 As String
   
5.     Dim 副檔名 As String
   
6.     Dim myFile As String
   
7.     Dim myPath As String
   
8.     Dim 舊檔名 As String
   
9.     Dim 新檔名 As String
   
10.     要替換 = Cells(4, 3)
    
11.     替換為 = Cells(4, 4)
    
12.     副檔名 = Cells(4, 5)
    
13.     myPath = ThisWorkbook.Path
    
14.     myFile = Dir(myPath & "\*." & 副檔名)
    
15.     Do While myFile <> "" '=>If myFile = "" Then Exit Do
    
16.         If myFile <> ThisWorkbook.Name Then   
    
17.             舊檔名 = myPath & "\" & myFile
    
18.             新檔名 = Replace(myFile, 要替換, 替換為)
    
19.             新檔名 = myPath & "\" & 新檔名
    
20.             Name 舊檔名 As 新檔名
    
21.         End If
    
22.         myFile = Dir '下一個檔案:
    
23.     Loop
    
24. End Sub

複製代碼

---

作者: n7822123    時間: 2015-11-30 11:54

回復 3# GBKEE


    不愧是超級版主，修改的簡潔易懂

---

歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)