Lấy giá trị của Worksheet từ Folder và SubFolder

Nhờ anh chị sửa giúp code em đang dùng lấy giá trị của file đang đóng từ Folder, nay phát sinh thêm em muốn lấy cả SubFolder mà code em không lấy được mong anh chị xem và điều chỉnh giúp em với ạ

Theo mình duyệt file và folder thì nên dùng FSO quản lý sẽ nhẹ nhàng hơn. cho phép truy xuất theo đuôi mở rộng và quét Sub folder cho bạn, ví dụ:

sub sample()
    Dim FileSystem As Object
    Dim HostFolder As String

HostFolder = "C:"
    '--> Đổi đường dẫn hoặc dùng Application.FileDialog(msoFileDialogFolderPicker) để lấy FOLDER_PATH'

Set FileSystem = CreateObject("Scripting.FileSystemObject")
    DoFolder FileSystem.GetFolder(HostFolder)
end  sub

Sub DoFolder(Folder)
    Dim SubFolder
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    For Each SubFolder In Folder.SubFolders
        DoFolder SubFolder
        ' Duyệt Sub Folder và đệ quy duyệt cả Sub của Sub :D'
    Next
    Dim File
    For Each File In Folder.Files
        ' Operate on each file'
        strFileName = File.Name
        strFilePath = File.Path
       strFileExt = objFSO.GetExtensionName(File)
        ' Đưa sub con để trích xuất dữ liệu vào đây.'
        'if strFileExt = "xls" ....
    Next
End Sub

Code cho trường hợp của bạn:
17748

Option Explicit
Sub GetFolder_Data_Collection()
    Dim colFiles    As Collection
    Dim sFile       As Variant, strPath As String
    Dim wsTarget    As Worksheet
    Dim wbSource    As Workbook
    Dim wsSource    As Worksheet
    Dim sht         As Worksheet
    Dim shtName     As String
    Dim LRow        As Long
    Dim rowTarget   As Long

Set wsTarget = Sheets("Sheet1")
    strPath = GetFolder
    Set colFiles = GetFileMatches(strPath, "*.xls*", True)

With wsTarget
        .Range("A:L").ClearContents
        .Range("A1").Resize(1, 5).Value = Array("Name", "Path", "Cell", "Value", "Numberformat")
    End With

shtName = InputBox(Prompt:="Enter the sheet name", Title:="Search Sheet")
    rowTarget = 2

For Each sFile In colFiles
        Set wbSource = Workbooks.Open(sFile)
        For Each sht In wbSource.Worksheets
            If sht.Name = shtName Then
                Set wsSource = wbSource.Sheets(shtName)
                LRow = wsSource.Range("E" & wsSource.Rows.Count).End(xlUp).Row

With wsTarget
                    .Range("A" & rowTarget).Value = wsSource.Range("E" & LRow).Value
                    .Range("B" & rowTarget).Formula = "=HYPERLINK(""" & sFile & """,""Click Open File"")"
                    .Range("B" & rowTarget).Font.Underline = False
                End With

rowTarget = rowTarget + 1
            End If
        Next sht
        wbSource.Close False
    Next sFile
End Sub

Function GetFileMatches(startFolder As String, filePattern As String, _
         Optional subFolders As Boolean = True) As Collection
    Dim fso         As Object, fldr As Object, f As Object, subFldr As Object
    Dim colFiles    As New Collection
    Dim colSub      As New Collection

Set fso = CreateObject("scripting.filesystemobject")
    colSub.Add startFolder

Do While colSub.Count > 0
        Set fldr = fso.GetFolder(colSub(1))
        colSub.Remove 1

For Each f In fldr.Files
            If UCase(f.Name) Like UCase(filePattern) Then colFiles.Add f
        Next f

If subFolders Then
            For Each subFldr In fldr.subFolders
                colSub.Add subFldr.Path
            Next subFldr
        End If
    Loop

Set GetFileMatches = colFiles
End Function

Function GetFolder() As String
    Dim fldr        As FileDialog
    Dim sItem       As String

Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
    With fldr
        .Title = "Select a Folder"
        .AllowMultiSelect = False
        .InitialFileName = Application.DefaultFilePath
        If .Show <> -1 Then GoTo NextCode
        sItem = .SelectedItems(1)
    End With

NextCode:
    GetFolder = sItem
    Set fldr = Nothing
End Function

Khóa học SprinGO phù hợp

Ứng dụng AI và Chat GPT trong Quản trị nhân sự

Học xong khóa này, học viên có thể: Hiểu đúng bản chất AI, các nhóm AI phổ biến và cách AI “hoạt động” ở...

Xem khóa học