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