Lấy danh sách tên các files trong folder

[nhatrang1986]

Chào các Anh/Chị ạ

Em có đoạn code (copy trên net) copy tên các file excel (*.xl*) vào sheets("main").cell(1,1) như dưới đây.

Tuy nhiên code mặc định folder để copy nay em muốn code thành "Brown tới folder cần lấy tên file"

Anh/Chị sửa giúp em đoạn code phía dưới hoặc là viết mới được thì tốt quá ạ. Cảm ơn./.

Sub list()
worksheets("main").cells(1,1).select
Dim F as string
F = Dir("D:\My Documents\" & "*.xl*")
Do While Len(F) > 0
ActiveCell.Formula = F
ActiveCell.Offset(1, 0).Select
F = Dir()
Loop
End sub

 

[be_09]

Chào các Anh/Chị ạ
Em có đoạn code (copy trên net) copy tên các file excel (*.xl*) vào sheets("main").cell(1,1) như dưới đây.
Tuy nhiên code mặc định folder để copy nay em muốn code thành "Brown tới folder cần lấy tên file"
Anh/Chị sửa giúp em đoạn code phía dưới hoặc là viết mới được thì tốt quá ạ. Cảm ơn./.

Chẳng hiểu lấy tên File để làm cái gì? Sao không lấy tên File và tạo Hyperlink luôn để còn mở File ?
Làm giùm bạn, chỉ lấy tên File trong 1 Folder, muốn lấy tên File trong Folder nào thì copy đường dẫn bỏ vào A1.
Xem code bài 5 (sửa lại theo nội dung bài 4).

 

[befaint]

Dir gặp unicode có dấu là tèo, đường dẫn quá dài (không nhớ rõ dài bao nhiêu) tèo...

 

[nhatrang1986]

Thanks all.
#be09: Mục đích của em là lấy tên file của các cửa hàng đã báo cáo vào cột A, sau đó đối chiếu với Danh sách các cửa hàng tại Cột B để kiểm tra cửa hàng nào đã báo cáo doanh số, cửa hàng nào chưa.
Code của be09 quá hay nếu trong folder đó toàn file excel tuy nhiên nó có nhiều loại file kèm như .docx hoặc .pdf hoặc .mp4 (để thuyết minh file .xl*). Vì vậy be09 có thể viết giùm em luon phần lọc chỉ lấy tên file dạng *.xl* được không ạ?

Many thnaks

 

[be_09]

Cảm ơn all.
#be09: Mục đích của em là lấy tên file của các cửa hàng đã báo cáo vào cột A, sau đó đối chiếu với Danh sách các cửa hàng tại Cột B để kiểm tra cửa hàng nào đã báo cáo doanh số, cửa hàng nào chưa.
Code của be09 quá hay nếu trong folder đó toàn file excel tuy nhiên nó có nhiều loại file kèm như .docx hoặc .pdf hoặc .mp4 (để thuyết minh file .xl*). Vì vậy be09 có thể viết giùm em luon phần lọc chỉ lấy tên file dạng *.xl* được không ạ?

Many thnaks

Thử lại:
Nên sử dụng tên File không dấu (tiếng Việt).

Sub LayTenFile_Excel()
    Dim DuongDan, TenFile As String
    Dim i As Integer, j As Integer
    Application.ScreenUpdating = False
    Sheet1.Range("A4:A500").ClearContents
    i = 3
    DuongDan = Sheet1.Range("A1")
    TenFile = Dir(DuongDan & "*.xl??")
    Do While TenFile <> ""
        i = i + 1
        j = 2
        Cells(i, 1) = TenFile
        TenFile = Dir()
    Loop
    Application.ScreenUpdating = True
End Sub

 

[ndu96081631]

Chào các Anh/Chị ạ

Em có đoạn code (copy trên net) copy tên các file excel (*.xl*) vào sheets("main").cell(1,1) như dưới đây.

Tuy nhiên code mặc định folder để copy nay em muốn code thành "Brown tới folder cần lấy tên file"

Anh/Chị sửa giúp em đoạn code phía dưới hoặc là viết mới được thì tốt quá ạ. Cảm ơn./.

Sub list()
worksheets("main").cells(1,1).select
Dim F as string
F = Dir("D:\My Documents\" & "*.xl*")
Do While Len(F) > 0
ActiveCell.Formula = F
ActiveCell.Offset(1, 0).Select
F = Dir()
Loop
End sub

Lúc trước tôi có viết một hàm chuyên lấy danh sách files, folders. Nó thế này:

Function FilesFoldersList(ByVal RootFolder As String, ByVal isFile As Boolean, _
                          ByVal Search As String, ByVal InSubFolder As Boolean)
  'RootFolder: Thu muc chi dinh
  'Search: Tu khóa dò tìm, cho phép dùng ký tu dai dien nhu *, ?
  'isFile: = True se lay danh sách các files và = False se lay danh sách các folders
  'InSubFolder: =True se lay danh sách trong các thu muc con
  '------------------------------------------------------------
  Dim sResult   As String
  Dim sCommand  As String
  Dim sTmpFile  As Variant
  Dim aRes()    As Variant
  Dim objFSO    As Object
  Dim objShell  As Object
  
  On Error Resume Next
  Set objFSO = CreateObject("Scripting.FileSystemObject")
  Set objShell = CreateObject("Wscript.Shell")
  If Right(RootFolder, 1) <> "\" Then RootFolder = RootFolder & "\"
  sCommand = """" & RootFolder & Search & """"
  
  sTmpFile = objFSO.GetTempName
  sCommand = "DIR " & sCommand & " /ON /B /A" & IIf(isFile, "-", "") & "D" & IIf(InSubFolder, "/S", " ") & " >" & sTmpFile
  objShell.Run "cmd /u /c " & sCommand, 0, True
  With objFSO.OpenTextFile(sTmpFile, 1, , -2)
    sResult = Trim(.ReadAll)
    If Right(sResult, 2) = vbCrLf Then sResult = Left(sResult, Len(sResult) - 2)
    If Len(sResult) Then
      If InSubFolder = False Then sResult = RootFolder & Replace(sResult, vbCrLf, vbCrLf & RootFolder)
      FilesFoldersList = Split(sResult, vbCrLf)
    End If
    .Close
  End With
  Kill sTmpFile
  Set objFSO = Nothing
  Set objShell = Nothing
End Function

Áp dụng vào file của bạn như sau:

Sub Main()
  Dim vFolder   As Variant
  Dim aRes      As Variant
  Dim Target    As Range
  On Error Resume Next
  vFolder = CreateObject("Shell.Application").BrowseForFolder(0, "", 1).Self.Path
  On Error GoTo 0
  Set Target = Range("A1") ''Là noi dat danh sách files
  If TypeName(vFolder) = "String" Then
    aRes = FilesFoldersList(CStr(vFolder), True, "*.xl*", True)
    If IsArray(aRes) Then
      Range(Target, Target.End(xlDown)).Clear
      Range("A1").Resize(UBound(aRes) + 1).Value = Application.Transpose(aRes)
      MsgBox "Done!"
    End If
  End If
End Sub

Hàm lấy bất cứ thứ gì bạn muốn. Nó hỗ trợ luôn tiếng Việt Unicode
Làm việc với file, folder thì không nên dùng Dir, nó không hỗ trợ Unicode đâu. Bạn có thể chọn dùng FileSystemObject hoặc giống cách tôi làm: dùng DOS Command

 

[nhatrang1986]

Một lần nữa cảm ơn Anh/Chị đã giúp đỡ ạ