zoukankan      html  css  js  c++  java
  • Excel VBA批量修改文件夹下的文件名

    今天,有同事提出想批量修改文件名,规则比较简单,在第五位后加“-”即可,

    上网没找到相关工具,就自己做了个excel,用宏代码修改。

    代码如下:

    Private Sub CommandButton1_Click()

    Dim varFileList As Variant

    MsgBox "选择要重命名文件所在的文件夹,点击确定!"

    With Application.FileDialog(msoFileDialogFolderPicker)
        .AllowMultiSelect = False
        .Show
       
        If .SelectedItems.Count = 0 Then Exit Sub '未选择文件夹
       
        renamepath = .SelectedItems(1)
       
        If Right(renamepath, 1) <> "" Then
            renamepath = renamepath + ""
        End If
    End With

    '获取文件夹中的所有文件列表
    varFileList = fcnGetFileList(renamepath)

    If Not IsArray(varFileList) Then
        MsgBox "未找到文件", vbInformation
        Exit Sub
    End If

    For l = 0 To UBound(varFileList)
        Dim fs
        Set fs = CreateObject("Scripting.FileSystemObject")
        oName = renamepath & CStr(varFileList(l))
        If fs.FileExists(oName) And Len(CStr(varFileList(l))) > 5 Then
            nName = renamepath & Left(CStr(varFileList(l)), 5) & "-" & Mid(CStr(varFileList(l)), 6)
            Name oName As nName
        End If
    Next l

    MsgBox "全部修改成功!哈哈", vbInformation

    End Sub

    Private Function fcnGetFileList(ByVal strPath As String, Optional strFilter As String) As Variant
    ' 将文件列表放到数组
    Dim f As String
    Dim i As Integer
    Dim FileList() As String

    If strFilter = "" Then strFilter = "*.*"
        Select Case Right(strPath, 1)
        Case "", "/"
        strPath = Left(strPath, Len(strPath) - 1)
    End Select

    ReDim Preserve FileList(0)
    f = Dir(strPath & "" & strFilter)
    Do While Len(f) > 0
        ReDim Preserve FileList(i) As String
        FileList(i) = f
        i = i + 1
        f = Dir()
    Loop
    If FileList(0) <> Empty Then
        fcnGetFileList = FileList
    Else
        fcnGetFileList = False
    End If

    End Function

  • 相关阅读:
    面试题33:把数组排成最小的数
    面试题32:从1到n整数中1出现的次数
    面试题31:连续子数组的最大和
    HTTPS 及加密信息全解析
    面试题30:最小的k个数
    linux退出vi
    linux清除当前屏幕
    java web开发环境配置
    jQuery积累
    html5离线应用详摘
  • 原文地址:https://www.cnblogs.com/dyllove98/p/3228643.html
Copyright © 2011-2022 走看看