20191105_Excel VBA 批量修改文件名作者：阙辉

----------------------改文件名主程序部分作者：阙辉---------------------

Sub huo_qu_lu_jing()    \'获取路径阙辉
Dim qh_lujing As String
qh_lujing = QH_Folder_select()
\'If qh_lujing = 0 Then Exit Sub
Sheets("Main").Range("C3") = qh_lujing
End Sub
Sub qh_huo_qu_wen()   \'获取原文件名阙辉
Dim QH_FileList_arry

With Sheets("Main")
    QH_FileList_arry = QH_FileList(.Range("C3"))
    For x = 0 To UBound(QH_FileList_arry)
        Cells(x + 5, 3) = QH_FileList_arry(x)
    Next x
End With
End Sub
Sub qh_huan_ming() \'改文件名阙辉
Dim qh_number, i As Long
Dim qh_lujing, _
    qh_gai_qian_name, _
    qh_gai_hou_name As String

With Sheets("Main")
    qh_lujing = .Range("C3")
    qh_number = .Range("c1048576").End(xlUp).Row
    For i = 5 To qh_number
        qh_gai_qian_name = .Cells(i, 3)
        qh_gai_hou_name = .Cells(i, 5)
        Name qh_lujing & "\" & qh_gai_qian_name As qh_lujing & "\" & qh_gai_hou_name
    Next
End With
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

Function QH_Folder_select(Optional qh_this_path = 0)        \'获取文件路径阙辉
Dim qh_strFolder As String
If qh_this_path = 0 Then
    With Application.FileDialog(msoFileDialogFolderPicker)
    .Show
    If .SelectedItems.Count = 0 Then
        strFolder = 0
        QH_Folder_select = strFolder
        Exit Function \'未选择文件夹
    Else
        strFolder = .SelectedItems(1)
    End If
End With
Else
    strFolder = ThisWorkbook.Path
End If
    QH_Folder_select = strFolder
End Function

Function QH_FileList(Optional qh_path = 0) \'获取文件列表
Dim qh_path_01 As String
Dim varFileList As Variant

If qh_path = 0 Then
    qh_path_01 = ThisWorkbook.Path
Else
    qh_path_01 = qh_path
End If

varFileList = fcnGetFileList(qh_path_01)   \'获取文件列表阙辉
If Not IsArray(varFileList) Then
    QH_FileList = 0
    Exit Function
End If

QH_FileList = varFileList

End Function
----------------------改文件名函数部分作者：阙辉----------------------

20191105_Excel VBA 批量修改文件名 作者：阙辉

20191105_Excel VBA 批量修改文件名作者：阙辉