Attribute VB_Name = "module"
Private Const dir_column As Long = 1
Private Const modifiedDir_column As Long = 2
Private Const fileName_column As Long = 3
Private Const fullpath_column As Long = 4

Public Sub setCellStyle(Row As Long, column As Long, Optional Font_Size As Integer = 12, Optional Borders_Weight As Integer = 2, Optional Color_Index As Integer = -1)
    ThisWorkbook.ActiveSheet.Cells(Row, column).NumberFormatLocal = "@"
    ThisWorkbook.ActiveSheet.Cells(Row, column).Font.Name = "宋体"
    ThisWorkbook.ActiveSheet.Cells(Row, column).Font.Size = Font_Size
    ThisWorkbook.ActiveSheet.Cells(Row, column).Borders.Weight = Borders_Weight
    ThisWorkbook.ActiveSheet.Cells(Row, column).Borders.Color = RGB(0, 0, 0)
    If Color_Index > -1 Then
        ThisWorkbook.ActiveSheet.Cells(Row, column).Interior.ColorIndex = Color_Index
    End If
End Sub


Public Function CreateListFile(strRootPath As String, strFileNamePattern As String, strList() As String) As Long

    Dim objFso As Object
    Dim objFile As Object
    Dim strFileList() As String
    Dim i, j, k As Long
    
    Set objFso = Nothing
    Set objFso = CreateObject("Scripting.Filesystemobject")
    
    i = 0
    Erase strList()
    
    For Each objFile In objFso.GetFolder(strRootPath).Files
        
        DoEvents
        
        'file name like pattern
        If objFile.Name Like strFileNamePattern Then
        
            'place to list buffer
            ReDim Preserve strList(i)
            
            strList(i) = objFile.Name
            
            i = i + 1
            
        End If
        
    Next
    
    For Each objfolder In objFso.GetFolder(strRootPath).subfolders
    
        DoEvents
        
        If Not objfolder.Attributes And (vbHidden) Then
            j = CreateListFile(strRootPath & "\" & objfolder.Name, strFileNamePattern, strFileList)
            For k = 0 To j - 1
                ReDim Preserve strList(i)
                strList(i) = objfolder.Name & "\" & strFileList(k)
                i = i + 1
            Next k
        End If
    Next
    
    CreateListFile = i
    
    Set objFile = Nothing
    Set objFso = Nothing
    
End Function


Public Function getFileColumn(startRow As Long, strFilePath As String, strFileName As String) As Long

    Dim wkBooks As Object
    Dim c As Range
    Dim iRow As Integer
    Dim relese_number As String
    Dim FilePath As String
    Dim FileDir As String
    Dim modifiedFileDir As String
    Dim FileName As String
    Dim env As String
    
    Application.ScreenUpdating = False
    Application.ShowWindowsInTaskbar = False
    Application.DisplayAlerts = False
    
    FilePath = strFileName
    idx1 = InStrRev(FilePath, "\")
    
    If idx1 > 0 Then
        FileDir = Mid(FilePath, 1, idx1 - 1)
        FileName = Mid(FilePath, idx1 + 1)
    Else
        FileDir = ""
        FileName = Mid(FilePath, 1)
    End If
    modifiedFileDir = Replace(FileDir, "\", "/")
    
    ThisWorkbook.ActiveSheet.Cells(startRow, dir_column).Value = FileDir
    ThisWorkbook.ActiveSheet.Cells(startRow, modifiedDir_column).Value = modifiedFileDir
    ThisWorkbook.ActiveSheet.Cells(startRow, fileName_column).Value = FileName
    Call setCellStyle(startRow, dir_column)
    Call setCellStyle(startRow, modifiedDir_column)
    Call setCellStyle(startRow, fileName_column)
    startRow = startRow + 1
    
    getFileColumn = startRow
    
    Application.ScreenUpdating = True
    Application.ShowWindowsInTaskbar = True
    Application.DisplayAlerts = True
  
End Function

Sub get_filelist()

    Dim strFileList() As String
    Dim iStartRow As Long
    Dim rootPath As String
    Dim j, k As Long
    Dim iRow As Long
    
    rootPath = ThisWorkbook.Path
    iStartRow = 1
    Call setCellStyle(iStartRow, dir_column, 15, 3, 10)
    ThisWorkbook.ActiveSheet.Cells(iStartRow, dir_column).Value = "目录"
    
    Call setCellStyle(iStartRow, modifiedDir_column, 15, 3, 10)
    ThisWorkbook.ActiveSheet.Cells(iStartRow, modifiedDir_column).Value = "变换后目录"
    
    Call setCellStyle(iStartRow, fileName_column, 15, 3, 10)
    ThisWorkbook.ActiveSheet.Cells(iStartRow, fileName_column).Value = "文件名"
    iStartRow = iStartRow + 1
    
    Call setCellStyle(iStartRow, dir_column, 15, 3, 23)
    ThisWorkbook.ActiveSheet.Cells(iStartRow, dir_column).Value = "\"
    
    Call setCellStyle(iStartRow, modifiedDir_column, 15, 3, 23)
    ThisWorkbook.ActiveSheet.Cells(iStartRow, modifiedDir_column).Value = "/"
    
    Call setCellStyle(iStartRow, fileName_column, 15, 3, 23)
    ThisWorkbook.ActiveSheet.Cells(iStartRow, fileName_column).Value = ""
    iStartRow = iStartRow + 1

    j = CreateListFile(rootPath, "*" & ".*", strFileList)
    For k = 0 To j - 1
        iStartRow = getFileColumn(iStartRow, rootPath, strFileList(k))
    Next k
    
    Call MsgBox("读取完毕", vbOKOnly + vbExclamation)
    
End Sub

Public Sub setFullPath(startRow As Long, flagRow As Long, column1 As Long, column2 As Long)
    Dim iRow As Long
    With ThisWorkbook.ActiveSheet
        For iRow = startRow To .UsedRange.Row + .UsedRange.Rows.Count - 1
            If Len(Trim(.Cells(iRow, column1).Value)) = 0 Then
                GoTo next_for
            End If
            Call setCellStyle(iRow, column2)
            .Cells(iRow, column2).Value = .Cells(iRow, column2).Value & .Cells(iRow, column1).Value & .Cells(flagRow, column1).Value
next_for:
        Next
    End With

End Sub


Sub fullpath_Click()
    Dim iColumn As Integer
    Dim c As Range
    
    With ThisWorkbook.ActiveSheet
        For iRow = 1 To .UsedRange.Row + .UsedRange.Rows.Count - 1
            .Cells(iRow, fullpath_column).Value = ""
        Next
    End With

    Call setCellStyle(1, fullpath_column, 15, 3, 23)
    ThisWorkbook.ActiveSheet.Cells(1, fullpath_column).Value = "全目录"

    With ThisWorkbook.Worksheets("setting")
        For iColumn = 1 To .UsedRange.column + .UsedRange.Columns.Count - 1
            If Len(Trim(.Cells(1, iColumn).Value)) = 0 Then
                Exit For
            End If
            
            Set c = ThisWorkbook.ActiveSheet.UsedRange.Rows(1).Find(what:=.Cells(1, iColumn).Value, LookIn:=xlValues, lookat:=xlWhole)
            If Not c Is Nothing Then
                Call setFullPath(3, 2, c.column, fullpath_column)
            End If
            
        Next
    End With

End Sub
Sub clear_Click()
    Dim iStartRow As Integer
    With ThisWorkbook.ActiveSheet
        .UsedRange.Interior.ColorIndex = 0
        .UsedRange.Value = ""
        .UsedRange.Borders.Weight = 1
        .UsedRange.Borders.LineStyle = xlNone
        .UsedRange.Borders.Color = xlNone
        
        'For iStartRow = 1 To 56
        '    .Cells(iStartRow, 1).Interior.ColorIndex = iStartRow
        'Next
    End With
End Sub