Cách lấy danh sách tên tệp dữ liệu bằng hàm VBA

Nếu macro của bạn cần biểu diễn một danh sách các tệp để người dùng lựa chọn, cách làm dễ dàng nhất là sử dụng GetOpenFileName của Application object (Đối tượng ứng dụng).

Ví dụ, mã code dưới đây biểu diễn hộp thoại File Open chuẩn. Nếu người dùng lựa chọn một tệp, tên tệp sẽ được lưu trữ trong SelectedFile (Tệp đã chọn); nếu người dùng bấm Cancel, SelectedFile sẽ False.

 Filter = "Excel files (*.xls), *.xls"
 Caption = "Select a File"
 SelectedFile = Application.GetOpenFilename(Filter, , Caption)

Trong một vài trường hợp, bạn sẽ muốn có một danh sách tất cả các tệp trong một danh mục riêng biệt. Hàm VBA bên dưới (GetFileList) chấp nhận một đường dẫn DOS và filespec như là đối số, và trả về một mảng biến thể chứa tất cả các tên tập tin trong thư mục đó. Nếu không tìm được tệp nào khớp, hàm sẽ trả về False.

Function GetFileList(FileSpec As String) As Variant
'   Returns an array of filenames that match FileSpec
'   If no matching files are found, it returns False

    Dim FileArray() As Variant
    Dim FileCount As Integer
    Dim FileName As String
    
    On Error GoTo NoFilesFound

    FileCount = 0
    FileName = Dir(FileSpec)
    If FileName = "" Then GoTo NoFilesFound
    
'   Loop until no more matching files are found
    Do While FileName <> ""
        FileCount = FileCount + 1
        ReDim Preserve FileArray(1 To FileCount)
        FileArray(FileCount) = FileName
        FileName = Dir()
    Loop
    GetFileList = FileArray
    Exit Function

'   Error handler
NoFilesFound:
    GetFileList = False
End Function

Chương trình con liệt kê bên dưới miêu tả cách sử dụng hàm này. Trong ví dụ, filespec được cho phép thông qua hàm GetFileList và kết quả được lưu giữ trong x. Nếu x là một mảng, có nghĩa là một tệp khớp đã được tìm thấy. Một hộp thông báo hiển thị sẽ biểu diễn một số lượng tệp và tên tệp được sao chép vào cột A trong Sheet1. Nếu x không phải một mảng, điều này có nghĩa là không có tệp phù hợp nào được tìm thấy.

Sub test()
    Dim p As String, x As Variant

    p = "c:/msoffice/excel/library/*.xls"
    x = GetFileList(p)
    Select Case IsArray(x)
        Case True 'files found
            MsgBox UBound(x)
            Sheets("Sheet1").Range("A:A").Clear
            For i = LBound(x) To UBound(x)
                Sheets("Sheet1").Cells(i, 1).Value = x(i)
            Next i
        Case False 'no files found
            MsgBox "No matching files"
    End Select
End Sub