返回列表 上一主題 發帖

[分享] 小工具-批次改檔名

[分享] 小工具-批次改檔名

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

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





批次改檔名範例檔.rar (27.34 KB)

回復 3# GBKEE


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

TOP

回復 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
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 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

批次改檔名範例檔.rar (27.55 KB)

TOP

        靜思自在 : 要批評別人時,先想想自己是否完美無缺。
返回列表 上一主題