office交流網--QQ交流群號

Access培訓群:792054000         Excel免費交流群群:686050929          Outlook交流群:221378704    

Word交流群:218156588             PPT交流群:324131555

Excel VBA 批量修改文件名

2020-04-24 08:00:00
tmtony8
原創
219

分享一箇自定義函數,批量修改文件名


Dim filePath As Variant            '定義filepath爲變量
Dim obj As Object                  '定義obj爲變量對象
Dim fld, ff, gg                    '定義fld,ff,gg爲變量
Sub getpath()
     Range("A1:Z1000").ClearContents               '清空該區域

    On Error Resume Next
     Dim shell As Variant
     Set shell = CreateObject("Shell.Application")
     Set filePath = shell.BrowseForFolder(&O0, "選擇文件夾", &H1 + &H10, "")   '穫取文件夾路徑地址
    Set shell = Nothing
   If filePath Is Nothing Then                 '檢測是否穫得有效路徑,如取消直接跳齣程序
       Exit Sub
     Else
        gg = filePath.Items.Item.Path
   End If
     Set obj = CreateObject("Scripting.FileSystemObject")   '定義變量
    Set fld = obj.getfolder(gg)                            '穫取路徑
     For Each ff In fld.Files                   '遍歷文件夾裡文件
        m = m + 1
         Cells(m + 1, 1) = ff.Name
         Cells(m + 1, 2) = "-------"
         Cells(m + 1, 3) = Right(ff.Name, Len(ff.Name) - 2)
       Next
 End Sub

 Sub renamefile()
 x = InputBox("原來的", "要改的")
      On Error Resume Next
      If [a2] = "" Then MsgBox "請點擊第一步": Exit Sub
       For Each ff In fld.Files                 '遍歷文件夾裡的所有文件
        m = m + 1
        ff.Name = x & Cells(m + 1, 3)             '將實際文件名改成目録中C列的對應文件名
      Next
       MsgBox "改名已完成,請檢查", vbOKOnly
 End Sub

分享