Duyệt file Excel trong sub folder (1 người xem)

  • Thread starter Thread starter lizzy
  • Ngày gửi Ngày gửi
Liên hệ QC

Người dùng đang xem chủ đề này

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
L

lizzy

Thành viên mới
Tham gia
7/6/09
Bài viết
8
Được thích
7
Chào các anh/chị,
Em đang làm quen với VBA trên Excel và gặp một số vấn đề sau nhờ giải đáp giúp:

* Em đang tạo 1 macro insert nội dung từ dòng A~E của sheet1 file hiện tại, vào all sheet cua all file excel nằm trong folder cho trước, kể cả thư mục con của thư mục trên. Tuy nhiên, hiện tại e chỉ insert đc cho các file nằm trong folder cha, còn các file trong folder con (sub folder) thi không insert được, vậy làm sao để duyệt va insert vao cac file excel ở folder con? Trong trường hợp e muốn cho chọn 1 trong 2 Option:
1. Insert vao all sheet.
2. chỉ insert data vao những sheetname có các ký tự cuối là "xyz" thì làm thế nào ạ?
Nội dung các cell tu A~E là công thức, khi copy nó lại refer đến file hiện tại, e muốn là refer đến nội dung trong chính sheet đc insert thì phải làm sao?

Day la doan code thuc hien CT tren hien tai cua e:
Mã: 
Set wb_src = ThisWorkbook
    FileList = Dir(txtDesFolder & "\*.XLS")   [COLOR=Red]'chi lay file excel trong FolderName, neu duyet luon sub folder thi sua lai nhu the nao???[/COLOR]

    Do Until FileList = ""
        'Open file trong destination folder
        Set wb_des  = Workbooks.Open(txtDesFolder & "\" & FileList)
        
       [COLOR=Red] 'Insert doang A~E vao all sheet cua workbooks dang mo, muon insert vao sheetname "..xyz" thi lam sao???[/COLOR]
        For i = 1 To wb_des.Sheets.Count
            For j = 1 To 5
                wb_des.Sheets(i).Rows(j).Insert
                wb_src.Sheets(1).Rows(j).Copy wbd.Sheets(i).Rows(j)
            Next j                
        Next i
      
        wb_des.Close (True)
        FileList = Dir()
        
        
        Set wb_des= Nothing
    Loop
Nho cac anh/chi giup do.
 
Lần chỉnh sửa cuối:
Sắp xếp theo thời gian sắp xếp theo bầu chọn
lizzy đã viết:
Chào các anh/chị,
Em đang làm quen với VBA trên Excel và gặp một số vấn đề sau nhờ giải đáp giúp:

* Em đang tạo 1 macro insert nội dung từ dòng A~E của sheet1 file hiện tại, vào all sheet cua all file excel nằm trong folder cho trước, kể cả thư mục con của thư mục trên. Tuy nhiên, hiện tại e chỉ insert đc cho các file nằm trong folder cha, còn các file trong folder con (sub folder) thi không insert được, vậy làm sao để duyệt va insert vao cac file excel ở folder con? Trong trường hợp e muốn cho chọn 1 trong 2 Option:
1. Insert vao all sheet.
2. chỉ insert data vao những sheetname có các ký tự cuối là "xyz" thì làm thế nào ạ?
Nội dung các cell tu A~E là công thức, khi copy nó lại refer đến file hiện tại, e muốn là refer đến nội dung trong chính sheet đc insert thì phải làm sao?

Day la doan code thuc hien CT tren hien tai cua e:
Mã: 
Set wb_src = ThisWorkbook
    FileList = Dir(txtDesFolder & "\*.XLS")   [COLOR=Red]'chi lay file excel trong FolderName, neu duyet luon sub folder thi sua lai nhu the nao???[/COLOR]

    Do Until FileList = ""
        'Open file trong destination folder
        Set wb_des  = Workbooks.Open(txtDesFolder & "\" & FileList)
        
       [COLOR=Red] 'Insert doang A~E vao all sheet cua workbooks dang mo, muon insert vao sheetname "..xyz" thi lam sao???[/COLOR]
        For i = 1 To wb_des.Sheets.Count
            For j = 1 To 5
                wb_des.Sheets(i).Rows(j).Insert
                wb_src.Sheets(1).Rows(j).Copy wbd.Sheets(i).Rows(j)
            Next j                
        Next i
      
        wb_des.Close (True)
        FileList = Dir()
        
        
        Set wb_des= Nothing
    Loop
Nho cac anh/chi giup do.
Nhấp chuột vào đây để mở rộng...
Không biết có phải bạn đang dùng UserForm không? Không thấy file nên cũng khó giúp
Tuy nhiên có thể gợi ý bạn dùng FileSearch
PHP: 
Sub Test()
  Dim iFN As Long, i As Long, j As Long
  Dim wb_src As Workbook, wb_des As Workbook
  Application.ScreenUpdating = False
  Set wb_src = ThisWorkbook
  With Application.FileSearch
    .SearchSubFolders = True   '<--- duyet tat ca cac file trong Sub Folders
    .LookIn = txtDesFolder     '<--- Tim trong folder nay
    .Filename = "*.xls"         '<--- Chi duyet file .xls
    If .Execute() > 0 Then
      For iFN = 1 To .FoundFiles.Count
        Set wb_des = Workbooks.Open(.FoundFiles(iFN))
        For i = 1 To wb_des.Sheets.Count
          wb_src.Sheets(1).Rows("1:5").Copy
          wb_des.Sheets(i).Rows(1).Insert Shift:=xlDown  '<--- Vua chen dong, vua paste du lieu
        Next i
        wb_des.Close (True)
      Next iFN
    End If
  End With
  Application.CutCopyMode = False
  Application.ScreenUpdating = True
End Sub
Bỏ bớt 1 vòng lập, vì Insert 5 dòng liên tiếp thì cũng chỉ cần 1 thao tác mà thôi (không cần phải For j = 1 to 5 đâu)
------------
Câu hỏi 2 của bạn:
2. chỉ insert data vao những sheetname có các ký tự cuối là "xyz" thì làm thế nào ạ?
Nội dung các cell tu A~E là công thức, khi copy nó lại refer đến file hiện tại, e muốn là refer đến nội dung trong chính sheet đc insert thì phải làm sao?
Nhấp chuột vào đây để mở rộng...
Tìm tên sheet có đuôi dạng "xyz" thì quá dể
PHP: 
For i = 1 To wb_des.Sheets.Count
  If Right(wb_des.Sheets(i).Name,3) = "xyz" then
     wb_src.Sheets(1).Rows("1:5").Copy
     wb_des.Sheets(i).Rows(1).Insert Shift:=xlDown
  End If
Next i
Còn vụ refer đến nội dung của chính sheet được insert, bạn có thể dùng Find and Replace mà làm
---------------------
Vài gợi ý nhỏ, nếu có file đính kèm sẽ thuận tiện hơn
 
Lần chỉnh sửa cuối:
Upvote 0
Chào bạn ndu9608163,
Cảm ơn sự giúp đỡ tận tình của bạn, mình đã làm được rồi :-=.
 
Upvote 0
Bạn lưu ý là đối lượng "FileSearch" không chạy được trong Office 2007. Nên tìm giải pháp khác thay thế và hôc trợ những tên file Unicode.
 
Upvote 0
TuanVNUNI đã viết:
Bạn lưu ý là đối lượng "FileSearch" không chạy được trong Office 2007. Nên tìm giải pháp khác thay thế và hôc trợ những tên file Unicode.
Nhấp chuột vào đây để mở rộng...
Vâng! Excel 2007 bỏ đối tương FileSearch nên nếu muốn lấy list file name trong cả Sub Folder thì hơi cực 1 chút (chứ không phải là không được)
Thử cái này xem:
PHP: 
Sub ListFilesInFolder(FolderName As String, InSub As Boolean)
  Dim FileItem As Scripting.File, SubFolder As Scripting.Folder
  On Error GoTo Thoat
  With New Scripting.FileSystemObject
    With .GetFolder(FolderName)
      For Each FileItem In .Files
        MsgBox (FileItem.Name)
      Next FileItem
      If InSub Then
        For Each SubFolder In .subFolders
          ListFilesInFolder SubFolder.Path, True
        Next SubFolder
      End If
    End With
  End With
Thoat:
End Sub
PHP: 
Sub Test()
  With Application.FileDialog(4)
    .Show: .AllowMultiSelect = False
    ListFilesInFolder .SelectedItems(1), True
  End With
End Sub
Đoạn code trên lấy tất cả các loại file... nếu muốn chỉ lấy file .xls thì thêm 1 cái IF nữa là xong!
 

File đính kèm

Upvote 0
hì, hiện tại thì mình vẫn dùng Excel 2k3. Về cơ bản chương trình chạy được rồi, cám ơn ndu96081631 và TuanVNUNI đã góp ý cho mình.
Hiện tại mình muốn update thêm 1 số tính năng sau:
1. Mình muốn Copy tất cả các file excel (copy luôn cả tên folder) trong đường dẫn muốn insert, ra đường dẫn khác, sau đó mới tiến hành insert (để giữ lại bản cũ), các folder không có File excel bên trong thì không copy.
VD:
Source path là Floder 1, có cấu trúc như sau:
Floder1
|- a.xls
|- b.txt
|- Floder2
|- c.xls
​
|- Floder3
|-d.txt
|-e.xls
​
|- Floder4
|- f.txt
​
Destination path là Test floder (hiện tại đang empty), sau khi copy thì có cấu trúc sau:
Test folder
|-Floder1
|- a.xls
|- Floder2
|- c.xls
|- Floder3
​
|-e.xls
​
Nhờ mọi người hướng dẫn giúp.

2. khi mình nhấn nút Browse để chỉ đường dẫn chọn Folder thì nó lại hiện dường dẫn trước đó mình đã chọn, bây h mình muốn khi nhấn nút Browse thì luôn hiện họp thoại mặc định là 1 đường dẫn nào đó (vd: D:\) thì làm cách nào?
đoạn code nút Browse:

Mã: 
Private Sub cmdBrFolder_Click()
 
    On Error Resume Next
    Application.FileDialog(msoFileDialogFolderPicker).Title = "Select Add Folder"
    Application.FileDialog(msoFileDialogFolderPicker).Show
    FolderName = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems("1")
    
    If FolderName <> "False" Then
        txtDesFolder = FolderName
    End If
End Sub
Cảm ơn nhiều.
 
Upvote 0
To ndu9608163: File của bạn lấy name các file trong một folder theo Msbog, bạn làm ơn đổi code để lấy ra một list name, nếu lấy thêm được cả dung lượng của từng file thì tốt quá. Xin chân thành cám ơn
 
Upvote 0
ngo15 đã viết:
To ndu9608163: File của bạn lấy name các file trong một folder theo Msbog, bạn làm ơn đổi code để lấy ra một list name, nếu lấy thêm được cả dung lượng của từng file thì tốt quá. Xin chân thành cám ơn
Nhấp chuột vào đây để mở rộng...
Thì chỉnh lại 1 tí thôi (quan trọng đoạn lấy dung lượng)
PHP: 
Private Sub ListFilesInFolder(FolderName As String, InSub As Boolean)
  Dim FileItem As Scripting.File, SubFolder As Scripting.Folder, FileName As String
  On Error GoTo Thoat
  With New Scripting.FileSystemObject
    With .GetFolder(FolderName)
      For Each FileItem In .Files
        FileName = FolderName & "\" & FileItem.Name
        Dic.Add FolderName & "\" & FileItem.Name, FileLen(FileName)
      Next FileItem
      If InSub Then
        For Each SubFolder In .subFolders
          ListFilesInFolder SubFolder.Path, True
        Next SubFolder
      End If
    End With
  End With
Thoat:
End Sub
PHP: 
Sub GetFileList()
  Dim i As Long
  Set Dic = Nothing
  Set Dic = CreateObject("Scripting.Dictionary")
  Range("A2:B60000").ClearContents
  With Application.FileDialog(4)
    .Show: .AllowMultiSelect = False
    ListFilesInFolder .SelectedItems(1), True
  End With
  With Range("A2").Resize(Dic.Count)
    .Value = WorksheetFunction.Transpose(Dic.Keys)
    .Offset(, 1) = WorksheetFunction.Transpose(Dic.Items)
    .Offset(, 1).NumberFormat = "# ""KB"""
  End With
  Columns("A:B").AutoFit
End Sub
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
Lay du lieu tu file excel nay sang file excel khac co cung cau truc trong 1 thu muc
Toi dang lam tong hop bao cao tai chinh, gio toi muon lay nguyen du lieu tu file XN1.XLS va file XN2.xls vao 1 file Tong hop toan Cty tren cung 1 sheet nhung du lieu o file xn1 se nam o 1 sheet; xn2 nam o 1 sheet.Lam sao de tu dong len file tong hop khi dua 2 file xn1 va xn2 vao Thu muc Tong hop bao cao.
Cac ban lam giup toi voi. Cam on cac ban.
 
Upvote 0
ndu96081631 đã viết:
Thì chỉnh lại 1 tí thôi (quan trọng đoạn lấy dung lượng)
PHP: 
Private Sub ListFilesInFolder(FolderName As String, InSub As Boolean)
  Dim FileItem As Scripting.File, SubFolder As Scripting.Folder, FileName As String
  On Error GoTo Thoat
  With New Scripting.FileSystemObject
    With .GetFolder(FolderName)
      For Each FileItem In .Files
        FileName = FolderName & "\" & FileItem.Name
        Dic.Add FolderName & "\" & FileItem.Name, FileLen(FileName)
      Next FileItem
      If InSub Then
        For Each SubFolder In .subFolders
          ListFilesInFolder SubFolder.Path, True
        Next SubFolder
      End If
    End With
  End With
Thoat:
End Sub
PHP: 
Sub GetFileList()
  Dim i As Long
  Set Dic = Nothing
  Set Dic = CreateObject("Scripting.Dictionary")
  Range("A2:B60000").ClearContents
  With Application.FileDialog(4)
    .Show: .AllowMultiSelect = False
    ListFilesInFolder .SelectedItems(1), True
  End With
  With Range("A2").Resize(Dic.Count)
    .Value = WorksheetFunction.Transpose(Dic.Keys)
    .Offset(, 1) = WorksheetFunction.Transpose(Dic.Items)
    .Offset(, 1).NumberFormat = "# ""KB"""
  End With
  Columns("A:B").AutoFit
End Sub
Nhấp chuột vào đây để mở rộng...

@ndu9608163: Ban ơi nếu mình muốn thêm tên file có cả hyperlink và thêm cột Date Modified thì phải sửa như thế nào? Bạn thông cảm vì mình mới đang nghiên cứu nên chưa hiểu các code. Mong bạn ndu9608163 và các bạn trong diễn đàn giúp đỡ.
 
Upvote 0
hoangvukkk đã viết:
@ndu9608163: Ban ơi nếu mình muốn thêm tên file có cả hyperlink và thêm cột Date Modified thì phải sửa như thế nào? Bạn thông cảm vì mình mới đang nghiên cứu nên chưa hiểu các code. Mong bạn ndu9608163 và các bạn trong diễn đàn giúp đỡ.
Nhấp chuột vào đây để mở rộng...

Tặng bạn file này nè!
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
thanhlanh đã viết:
Tặng bạn file này nè!
Nhấp chuột vào đây để mở rộng...

Cám ơn bạn thanhlanh rất nhiều! Bạn ơi, mình thấy file bạn gửi cho mình có đầy đủ những thứ mình cần như TT, Tên file và đường dẫn, Size, Date create, Date modified .v.v., tuy nhiên sao mình thấy cách tìm chậm lắm, nhất là đối với thư mục chứa nhiều file và thư mục con, vậy nên mình rất muốn bạn và mọi người trong diễn đàn giúp mình sửa từ file ListFileInFolder_2.xls của bạn ndu96081631 .Thực tế mình cần lấy thêm hyperlink, Date create, Date modified và mình cần hiểu code nào yêu cầu phải Browse tới thư mục cần tìm file, và code nào tìm trực tiếp trong thư mục chứa file excel. Híc, mong các bạn hết sức giúp đỡ, mình đang rất cần câu trả lời về vấn đề này.
Chân thành cảm ơn!
 
Upvote 0
thanhlanh đã viết:
Tặng bạn file này nè!
Nhấp chuột vào đây để mở rộng...
Code gì mà dài thấy ngán vậy bạn?
Tôi nghĩ ngắn chừng 1/3 số đô cũng là quá nhiều rồi
Bạn thấy code tại bài số 8 đã lấy được tên file và dung lượng, giờ nếu lấy thêm thuộc tính thời gian thì cùng lắm cũng chỉ thêm vài dòng code nữa là đủ
Hãy nghiên cứu bài 8 và cải tiến lại, chẳng hạn là vầy:
PHP: 
Private Sub ListFilesInFolder(FolderName As String, InSub As Boolean)
  Dim FileItem As Scripting.File, SubFolder As Scripting.Folder, FileName As String
  On Error GoTo ExitSub
  With New Scripting.FileSystemObject
    For Each FileItem In .GetFolder(FolderName).Files
      If .GetExtensionName(FileItem.Path) = "xls" Then
        With Range("A65536").End(xlUp)
          With .Offset(1, 0)
            .Value = FileItem.Path
            .Parent.Hyperlinks.Add .Cells, .Value
          End With
          .Offset(1, 1) = FileItem.Size
          .Offset(1, 2) = FileItem.DateCreated
          .Offset(1, 3) = FileItem.DateLastModified
        End With
      End If
    Next FileItem
    If InSub Then
      For Each SubFolder In .GetFolder(FolderName).SubFolders
         ListFilesInFolder SubFolder.Path, True
      Next SubFolder
    End If
  End With
ExitSub:
End Sub
PHP: 
Sub GetFileList()
  On Error GoTo ExitSub
  Range("A2:D60000").ClearContents
  With Application.FileDialog(4)
    .Show: .AllowMultiSelect = False
    ListFilesInFolder .SelectedItems(1), True
  End With
  Columns("A:D").AutoFit
ExitSub:
End Sub
Code trên chỉ lấy file dạng xls ---> Nếu muốn lấy những đuôi file khác, hãy sửa đoạn If .GetExtensionName(FileItem.Path) = "xls" Then thành cái gì tùy ý
 

File đính kèm

Upvote 0
ndu96081631 đã viết:
Code gì mà dài thấy ngán vậy bạn?
Tôi nghĩ ngắn chừng 1/3 số đô cũng là quá nhiều rồi
Bạn thấy code tại bài số 8 đã lấy được tên file và dung lượng, giờ nếu lấy thêm thuộc tính thời gian thì cùng lắm cũng chỉ thêm vài dòng code nữa là đủ
Hãy nghiên cứu bài 8 và cải tiến lại, chẳng hạn là vầy:
PHP: 
Private Sub ListFilesInFolder(FolderName As String, InSub As Boolean)
  Dim FileItem As Scripting.File, SubFolder As Scripting.Folder, FileName As String
  On Error GoTo ExitSub
  With New Scripting.FileSystemObject
    For Each FileItem In .GetFolder(FolderName).Files
      If .GetExtensionName(FileItem.Path) = "xls" Then
        With Range("A65536").End(xlUp)
          With .Offset(1, 0)
            .Value = FileItem.Path
            .Parent.Hyperlinks.Add .Cells, .Value
          End With
          .Offset(1, 1) = FileItem.Size
          .Offset(1, 2) = FileItem.DateCreated
          .Offset(1, 3) = FileItem.DateLastModified
        End With
      End If
    Next FileItem
    If InSub Then
      For Each SubFolder In .GetFolder(FolderName).SubFolders
         ListFilesInFolder SubFolder.Path, True
      Next SubFolder
    End If
  End With
ExitSub:
End Sub
PHP: 
Sub GetFileList()
  On Error GoTo ExitSub
  Range("A2:D60000").ClearContents
  With Application.FileDialog(4)
    .Show: .AllowMultiSelect = False
    ListFilesInFolder .SelectedItems(1), True
  End With
  Columns("A:D").AutoFit
ExitSub:
End Sub
Code trên chỉ lấy file dạng xls ---> Nếu muốn lấy những đuôi file khác, hãy sửa đoạn If .GetExtensionName(FileItem.Path) = "xls" Then thành cái gì tùy ý
Nhấp chuột vào đây để mở rộng...

Cảm ơn bạn đã giúp đỡ mình rất nhiều,file của bạn rất sát với mục đích của mình, suốt từ khi bạn gửi câu trả lời cho mình, mình cũng ngồi tìm hiểu và sửa lại 1 chút để phù hợp hơn với mình, tuy nhiên còn 1 vài điểm mình muốn hỏi thêm bạn.
1: Làm thế nào để bỏ cửa sổ Browse folder (Chỉ tìm trong thư mục chứa file) ? Mình thử áp dụng theo bài số 2# nhưng không được
2: Nếu muốn lấy cùng lúc nhiều định dạng file thì làm thế nào, VD doc, xls, jpg ?
3: Khi bỏ dòng If .GetExtensionName(FileItem.Path) = "xls" Then để lấy tất cả các định dạng file hoặc chỉ lấy rất nhiều file xls (>200) thì thỉnh thoảng gặp trường hợp những file ở giữa danh sách trở đi không thể mở được bằng cách kích chuột vào link (Báo lỗi Cannot open the Specified file) ?
4:Trong câu hỏi 3, Thỉnh thoảng gặp trường hợp tự Break lệnh, nghĩa là chỉ liệt kê ra khoảng 20 file trong lần chạy 1, lần chạy 2 thêm được vài file, và từ lần sau chạy cũng không thêm được file nào nữa ?
Mình rất mong nhận được câu trả lời sớm của bạn.
Chân thành cảm ơn!
 
Upvote 0
hoangvukkk đã viết:
Cám ơn bạn thanhlanh rất nhiều! Bạn ơi, mình thấy file bạn gửi cho mình có đầy đủ những thứ mình cần như TT, Tên file và đường dẫn, Size, Date create, Date modified .v.v., tuy nhiên sao mình thấy cách tìm chậm lắm, nhất là đối với thư mục chứa nhiều file và thư mục con, vậy nên mình rất muốn bạn và mọi người trong diễn đàn giúp mình sửa từ file ListFileInFolder_2.xls của bạn ndu96081631 .Thực tế mình cần lấy thêm hyperlink, Date create, Date modified và mình cần hiểu code nào yêu cầu phải Browse tới thư mục cần tìm file, và code nào tìm trực tiếp trong thư mục chứa file excel. Híc, mong các bạn hết sức giúp đỡ, mình đang rất cần câu trả lời về vấn đề này.
Chân thành cảm ơn!
Nhấp chuột vào đây để mở rộng...
Ừ thì do mình muốn làm tổng quát, đầy đủ nên nó chậm (có khả năng là do giải thuật nữa), bạn có thể bỏ bớt công việc nào không cần thiết (trong code) cho nó nhanh.
ndu đã viết:
Code gì mà dài thấy ngán vậy bạn?
Tôi nghĩ ngắn chừng 1/3 số đô cũng là quá nhiều rồi
Bạn thấy code tại bài số 8 đã lấy được tên file và dung lượng, giờ nếu lấy thêm thuộc tính thời gian thì cùng lắm cũng chỉ thêm vài dòng code nữa là đủ
Hãy nghiên cứu bài 8 và cải tiến lại
Nhấp chuột vào đây để mở rộng...
Tôi cũng đã chạy thử ListFileInFolder_2.xls nhưng hình như nếu mình chọn trúng thư mục trống, cho nó tìm thì nó báo lỗi Anh à. Còn ListFileInFolder_3.xls tôi sẽ nghiên cứu, có điều ... trình độ tôi chưa hiểu hết các câu lệnh của Anh. Ví dụ đoạn này:
With Application.FileDialog(4)
.Show: .AllowMultiSelect = False
ListFilesInFolder .SelectedItems(1), True
End With
Nhân tiện, nhờ Anh giải thích luôn, xin cảm ơn!
 
Lần chỉnh sửa cuối:
Upvote 0
hoangvukkk đã viết:
Cảm ơn bạn đã giúp đỡ mình rất nhiều,file của bạn rất sát với mục đích của mình, suốt từ khi bạn gửi câu trả lời cho mình, mình cũng ngồi tìm hiểu và sửa lại 1 chút để phù hợp hơn với mình, tuy nhiên còn 1 vài điểm mình muốn hỏi thêm bạn.
1: Làm thế nào để bỏ cửa sổ Browse folder (Chỉ tìm trong thư mục chứa file) ? Mình thử áp dụng theo bài số 2# nhưng không được
2: Nếu muốn lấy cùng lúc nhiều định dạng file thì làm thế nào, VD doc, xls, jpg ?
3: Khi bỏ dòng If .GetExtensionName(FileItem.Path) = "xls" Then để lấy tất cả các định dạng file hoặc chỉ lấy rất nhiều file xls (>200) thì thỉnh thoảng gặp trường hợp những file ở giữa danh sách trở đi không thể mở được bằng cách kích chuột vào link (Báo lỗi Cannot open the Specified file) ?
4:Trong câu hỏi 3, Thỉnh thoảng gặp trường hợp tự Break lệnh, nghĩa là chỉ liệt kê ra khoảng 20 file trong lần chạy 1, lần chạy 2 thêm được vài file, và từ lần sau chạy cũng không thêm được file nào nữa ?
Mình rất mong nhận được câu trả lời sớm của bạn.
Chân thành cảm ơn!
Nhấp chuột vào đây để mở rộng...
1> Sửa thằng này:
PHP: 
With Application.FileDialog(4)
  .Show: .AllowMultiSelect = False
  ListFilesInFolder .SelectedItems(1), True
End With
thành:
ListFilesInFolder ThisWorkbook.Path, True
Chú ý chữ True màu đỏ, Sửa thành False nếu bạn không muốn lấy file trong thu mục con
----------------
2> Lấy định dạng khác thì sửa cái IF ấy thành khác
Ví dụ lấy xls và doc thì sửa thằng:
If .GetExtensionName(FileItem.Path) = "xls" Then
thành
If .GetExtensionName(FileItem.Path) = "xls" Or .GetExtensionName(FileItem.Path) = "doc" Then
----------------
3> Có phải file nào cũng bấm link đựoc đâu chứ ---> Chẳng hạn file DLL thì mở bằng cái gì? báo lỗi Cannot open the Specified file là đưong nhiên
----------------
4> Ở sub đầu tiên, thử thay đoạn:
On Error GoTo ExitSub
thành:
On Error Resume Next
xem thế nào
--------------------------------------------------------------
Nói chung, bài này lý ra ta nên xây dựng 1 UserForm để lấy file ---> Trong UserForm này ta tự định nghĩa những loại file ta cần lấy
Các bạn tự nghiên cứu xem ---> Tôi nghĩ chẳng khó tí nào đâu
--------------------------------------------------------------
thanhlanh đã viết:
Còn ListFileInFolder_3.xls tôi sẽ nghiên cứu, có điều ... trình độ tôi chưa hiểu hết các câu lệnh của Anh. Ví dụ đoạn này:
With Application.FileDialog(4)
.Show: .AllowMultiSelect = False
ListFilesInFolder .SelectedItems(1), True
End With
Nhân tiện, nhờ Anh giải thích luôn, xin cảm ơn!
Nhấp chuột vào đây để mở rộng...
Đây là những thứ có sẳn trong VBA ---> Cứ bôi đen lệnh nào cần nghiên cứu rồi F1 sẽ có câu trả lời
 
Lần chỉnh sửa cuối:
Upvote 0
1. Sau khi xem thật kỹ lại bài #16 và thử đi thử lại các code, mình thấy lỗi Cannot open the Specified file xuất hiện khi mình đổi code .Value = FileItem.Path thành .Value = FileItem.Name để chỉ lấy tên file trong 1 thư mục và các thư mục con của nó chứ không lấy cả đường dẫn. Tất nhiên mình không dùng file excel này để tìm file DLL rồi, mình chỉ tìm các file thông dụng như doc, xls, dwg... thôi.
2. Khi mình muốn bắt đầu ghi dữ liệu từ ô A5 thì mình thử như sau
--------------------------------------------------------------------
With Range("A65536").End(xlUp)
With .Offset(1, 0) ============> With .Offset(5, 0)
.Value = FileItem.Path
.Parent.Hyperlinks.Add .Cells, .Value
End With
.Offset(1, 1) = FileItem.Size ===============> .Offset(5, 1) = FileItem.Size
.Offset(1, 2) = FileItem.DateCreated ===============> .Offset(5, 2) = FileItem.DateCreated
.Offset(1, 3) = FileItem.DateLastModified ===============> .Offset(5, 3) = FileItem.DateLastModified
End With
------------------------------------------------
Nhưng không được, vậy các bạn có thể xem và giúp mình được không?
Rất mong nhận được hồi âm.
Chân thành cảm ơn!
 
Upvote 0
hoangvukkk đã viết:
2. Khi mình muốn bắt đầu ghi dữ liệu từ ô A5 thì mình thử như sau
--------------------------------------------------------------------
With Range("A65536").End(xlUp)
With .Offset(1, 0) ============> With .Offset(5, 0)
.Value = FileItem.Path
.Parent.Hyperlinks.Add .Cells, .Value
End With
.Offset(1, 1) = FileItem.Size ===============> .Offset(5, 1) = FileItem.Size
.Offset(1, 2) = FileItem.DateCreated ===============> .Offset(5, 2) = FileItem.DateCreated
.Offset(1, 3) = FileItem.DateLastModified ===============> .Offset(5, 3) = FileItem.DateLastModified
End With
------------------------------------------------
Nhưng không được, vậy các bạn có thể xem và giúp mình được không?
Rất mong nhận được hồi âm.
Chân thành cảm ơn!
Nhấp chuột vào đây để mở rộng...
Để ghi dữ liệu bắt đầu từ A5, bạn không cần phải sửa bất cứ code nào, chỉ việc gõ gì đó vào dòng 4 là đựoc rồi ---> Chẳng hạn bạn có thể dùng dòng 4 làm sẳn 1 tiêu đề
Thử xem
 
Upvote 0
Bạn ndu96081631 ơi code của bạn mình sửa lại 1 chút như thế này để cột A là thư mục và link chứa file, cột B là Tên và link file

--------------------------------------------------------------------------------
Private Sub ListFilesInFolder(FolderName As String, InSub As Boolean)
Dim FileItem As Scripting.File, SubFolder As Scripting.Folder, FileName As String
On Error GoTo ExitSub
With New Scripting.FileSystemObject
For Each FileItem In .GetFolder(FolderName).Files
If .GetExtensionName(FileItem.Path) = "xls" Then
With Range("A65536").End(xlUp)
With .Offset(1, 0)
.Value = FileItem.ParentFolder
.Parent.Hyperlinks.Add .Cells, .Value
End With
With .Offset(1, 1)
.Value = FileItem.Name
.Parent.Hyperlinks.Add .Cells, .Value
End With
.Offset(1, 2) = FileItem.Size
.Offset(1, 3) = FileItem.DateCreated
.Offset(1, 4) = FileItem.DateLastModified
End With
End If
Next FileItem
If InSub Then
For Each SubFolder In .GetFolder(FolderName).SubFolders
ListFilesInFolder SubFolder.Path, True
Next SubFolder
End If
End With
ExitSub:
End Sub
-------------------------------------------------------------
Cột A hoạt động tốt, nhưng cột B là tên file thì có link chạy, có link lại báo là Cannot open the Specified file , bạn xem giúp mình với, hay là code mình sửa bị sai phần nào?
Mong sớm nhận được câu trả lời từ bạn.
Chân thành cảm ơn!
 
Upvote 0
hoangvukkk đã viết:
Bạn ndu96081631 ơi code của bạn mình sửa lại 1 chút như thế này để cột A là thư mục và link chứa file, cột B là Tên và link file

--------------------------------------------------------------------------------
PHP: 
Private Sub ListFilesInFolder(FolderName As String, InSub As Boolean)
    .............
   .............
            With .Offset(1, 0)
                .Value = FileItem.ParentFolder
                .Parent.Hyperlinks.Add .Cells, .Value
            End With
            With .Offset(1, 1)
                .Value = FileItem.Name
                .Parent.Hyperlinks.Add .Cells, .Value
            End With
  ............
  ............
End Sub
-------------------------------------------------------------
Cột A hoạt động tốt, nhưng cột B là tên file thì có link chạy, có link lại báo là Cannot open the Specified file , bạn xem giúp mình với, hay là code mình sửa bị sai phần nào?
Mong sớm nhận được câu trả lời từ bạn.
Chân thành cảm ơn!
Nhấp chuột vào đây để mở rộng...
Bạn viết code thế thì chỉ mở đựoc các file cùng cấp mà thôi! Những chổ không thể mở link thì đấy chắc chắn là file nằm trong 1 thu mục con
Sửa chổ này:
PHP: 
With .Offset(1, 0)
  .Value = FileItem.ParentFolder
  .Parent.Hyperlinks.Add .Cells, .Value
End With
With .Offset(1, 1)
  .Value = FileItem.Name
  .Parent.Hyperlinks.Add .Cells, .Value
End With
Thành vầy:
PHP: 
With .Offset(1, 0)
  .Value = FileItem.ParentFolder.Path
  .Parent.Hyperlinks.Add .Cells, .Value
End With
With .Offset(1, 1)
  .Value = FileItem.Name
  .Parent.Hyperlinks.Add .Cells, FileItem.Path
End With
 
Upvote 0
Add tất cả hình

Chào cả nhà,
được xem file ví dụ của các anh thật hay và bổ ích.
mình có thử áp dụng vào trường hợp của mình nhưng vẫn chưa hoàn thiện (đã mấy ngày ngâm cứu rùi :)). nhờ các anh chỉ giúp xem đang kẹt ở đâu với nhé.
trường hợp của mình muốn là: - Add tất cả các hình (có trong folder đã chỉ định) dựa trên giá trị của Cell mình chọn (Cell chứa tên hình, với định dạng JPG)
Vấn đề: Code của mình chỉ chạy được 1 lần, nếu chạy lần 2nd thì giá trị của i không chịu về 0 mà tiếp tục tăng làm mình không Select được Range mới.
mình gửi file ví dụ, các bác giúp em với.
thanks cả nhà.
 

File đính kèm

Upvote 0
william.hoang74 đã viết:
Chào cả nhà,
được xem file ví dụ của các anh thật hay và bổ ích.
mình có thử áp dụng vào trường hợp của mình nhưng vẫn chưa hoàn thiện (đã mấy ngày ngâm cứu rùi :)). nhờ các anh chỉ giúp xem đang kẹt ở đâu với nhé.
trường hợp của mình muốn là: - Add tất cả các hình (có trong folder đã chỉ định) dựa trên giá trị của Cell mình chọn (Cell chứa tên hình, với định dạng JPG)
Vấn đề: Code của mình chỉ chạy được 1 lần, nếu chạy lần 2nd thì giá trị của i không chịu về 0 mà tiếp tục tăng làm mình không Select được Range mới.
mình gửi file ví dụ, các bác giúp em với.
thanks cả nhà.
Nhấp chuột vào đây để mở rộng...

Code của bạn:
Mã: 
Sub ListFolder(txtDesFolder As String, InSub As Boolean)
    Dim txtFileItem As Scripting.File, txtSubFolder As Scripting.Folder
    [COLOR=#ff0000]Static i As Long[/COLOR], sltRange As Range
    ......................
End Sub
Sub Addpictures()
  [COLOR=#ff0000]Dim i As Long[/COLOR]
  With Application.FileDialog(msoFileDialogFolderPicker)
    .Show: .AllowMultiSelect = False
    ListFolder .SelectedItems(1), True
  End With
End Sub
Sửa thành:
Mã: 
[COLOR=#ff0000]Public i As Long[/COLOR]
Sub ListFolder(txtDesFolder As String, InSub As Boolean)
    Dim txtFileItem As Scripting.File, txtSubFolder As Scripting.Folder
    Dim sltRange As Range
    .............
End Sub
Sub Addpictures()
  [COLOR=#ff0000]i = 0[/COLOR]
  With Application.FileDialog(msoFileDialogFolderPicker)
    .Show: .AllowMultiSelect = False
    ListFolder .SelectedItems(1), True
  End With
End Sub
Những chỗ màu đỏ là chỗ đã sửa
------------------
Nói thêm: Code này vẫn chưa hay, còn phải sửa lại rất nhiều
 
Lần chỉnh sửa cuối:
Upvote 0
nếu sửa lại phải sửa thế nào ha bác.
lúc trước mình muốn dùng array nhưng chưa quen sử dụng array nên chuyển qua cách này.
tuy nhiên, cách này mình này 1 số bước vẫn còn bị lặp lại (do có sử dụng vòng lặp) nhưng kh6ong biết phải xử lý thế nào.
bác xem có thể chỉnh giúp mình cho code nó chạy hoàn thiện và nhanh hơn được không!!!
trong đoạn code:
Mã: 
For j = 1 To sltRange.Areas.Count
                'lay hinh trong thu muc theo gia tri cua txtdesfolder
                For Each objCell In sltRange.Areas(j)
                    objCell.RowHeight = 50
                    objCell.Offset(0, -1).Select
                    On Error Resume Next
                    ActiveSheet.Pictures.Insert(txtDesFolder & "\" & objCell & ".JPG").Select
                    Selection.ShapeRange.Height = 45
                    Selection.Placement = xlMoveAndSize
                Next objCell
                If j > sltRange.Areas.Count Then j = 1
            Next j
khi Selection có 2 range, duyệt lần đầu thì j duyệt được 2 lần, nhưng khi duyệt vào subfolder thì đến vòng lặp này không lặp được mà thoát ngay. (mình không biết lý do tại sao !$@!!).
cảm ơn bác nhiều.
 
Lần chỉnh sửa cuối:
Upvote 0
mới gửi hỏi bác thì mình sửa được cái lỗi ở vòng lặp @$@!^%

chỉ cần khai báo Static sltRange thay vì Dim sltRange là chạy được.
Mã: 
Public i As Long
Sub ListFolder(txtDesFolder As String, InSub As Boolean)
    Dim txtFileItem As Scripting.File, txtSubFolder As Scripting.Folder
    [COLOR=#ff0000]Static sltRange As Range[/COLOR]
    Dim j As Long, objCell As Range
    'On Error GoTo Thoat
    With New Scripting.FileSystemObject
        With .GetFolder(txtDesFolder)
            i = i + 1
            If i > 1 Then GoTo lapkhongsetrange
            Set sltRange = Application.InputBox("Chon Cell", , , , , , , 8)
lapkhongsetrange:
            For j = 1 To sltRange.Areas.Count
                'lay hinh trong thu muc theo gia tri cua txtdesfolder
                For Each objCell In sltRange.Areas(j)
                    objCell.RowHeight = 50
                    objCell.Offset(0, -1).Select
                    On Error Resume Next
                    ActiveSheet.Pictures.Insert(txtDesFolder & "\" & objCell & ".JPG").Select
                    Selection.ShapeRange.Height = 45
                    Selection.Placement = xlMoveAndSize
                Next objCell
                If j > sltRange.Areas.Count Then j = 1
            Next j
            If InSub Then
                For Each txtSubFolder In .SubFolders
                    ListFolder txtSubFolder.Path, True
                Next txtSubFolder
            End If
        End With
    End With
    'Thoat:
End Sub
--------------------------------------------------------
Sub Addpictures()
  i = 0
  With Application.FileDialog(msoFileDialogFolderPicker)
    .Show: .AllowMultiSelect = False
    ListFolder .SelectedItems(1), True
  End With
End Sub
 
Upvote 0
ndu96081631 đã viết:
Thì chỉnh lại 1 tí thôi (quan trọng đoạn lấy dung lượng)
PHP: 
Private Sub ListFilesInFolder(FolderName As String, InSub As Boolean)
  Dim FileItem As Scripting.File, SubFolder As Scripting.Folder, FileName As String
  On Error GoTo Thoat
  With New Scripting.FileSystemObject
    With .GetFolder(FolderName)
      For Each FileItem In .Files
        FileName = FolderName & "\" & FileItem.Name
        Dic.Add FolderName & "\" & FileItem.Name, FileLen(FileName)
      Next FileItem
      If InSub Then
        For Each SubFolder In .subFolders
          ListFilesInFolder SubFolder.Path, True
        Next SubFolder
      End If
    End With
  End With
Thoat:
End Sub
PHP: 
Sub GetFileList()
  Dim i As Long
  Set Dic = Nothing
  Set Dic = CreateObject("Scripting.Dictionary")
  Range("A2:B60000").ClearContents
  With Application.FileDialog(4)
    .Show: .AllowMultiSelect = False
    ListFilesInFolder .SelectedItems(1), True
  End With
  With Range("A2").Resize(Dic.Count)
    .Value = WorksheetFunction.Transpose(Dic.Keys)
    .Offset(, 1) = WorksheetFunction.Transpose(Dic.Items)
    .Offset(, 1).NumberFormat = "# ""KB"""
  End With
  Columns("A:B").AutoFit
End Sub
Nhấp chuột vào đây để mở rộng...

Mình muốn thêm một cột có link file bằng công thức, và môt cột chỉ lấy tên file thôi thì làm thế nào? Bạn giúp mình với.
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.

Bài viết mới nhất

T
Nhờ các anh chị sửa dùm công thức ạ. (1 người xem)
Trả lời
10
Đọc
112
trantrungvinh1989
T
T
Tìm số hóa đơn trong chuỗi
Trả lời
10
Đọc
382
tranhungdao12a3
T
C
Chia sẻ: Kết quả xổ số Keno (2 người xem)
    • Cười
    • Thích
Trả lời
24
Đọc
2K
phuongdaik98
P
Phan Thế Hiệp
Quy đổi từ Thu nhập sau thuế (TNCN) ra Thu nhập tính thuế (1 người xem)
    • Yêu thích
    • Thích
Trả lời
1
Đọc
267
Phan Thế Hiệp
Phan Thế Hiệp
V
Quên mật khẩu file excel
Trả lời
25
Đọc
2K
YêuCN
Y
Nguyen Rem
  • Question Question
Lỗi "User-defined type not defined" khi khai báo biến
Trả lời
28
Đọc
2K
nguyendang95
N
E
Đánh số cho các cặp số chứng từ và số chứng từ đối ứng
Trả lời
13
Đọc
259
dazkangel
dazkangel
NguyenthiH
Mở file Excel có Pass Open
Trả lời
37
Đọc
3K
kimthoa26
kimthoa26
OverAC
  • Dán lên cao
  • Suggestion Suggestion
Chúc mừng sinh nhật GiaiPhapExcel 19 tuổi và tặng ebook "Lập trình VBA phần cơ bản."
    • Thích
    • Yêu thích
Trả lời
5
Đọc
1K
longlacda
L
V
Công thức để phân công chuyên môn cho giáo viên
Trả lời
5
Đọc
274
vietvanyen
V
G
AddIn convert ngày dương lịch sang âm lịch và ngược lại + đọc ngày tháng
Trả lời
20
Đọc
10K
du trung kien
D
8
Hàm trong excel
Trả lời
3
Đọc
74
Hoàng Tuấn 868
H
N
Chuyển giờ công từ bảng công vào bảng tính (2 người xem)
Trả lời
16
Đọc
298
ngouyen1505
N
N
Tạo COM Add-In bằng Visual C++
    • Thích
Trả lời
7
Đọc
679
nguyendang95
N
Nga1852k
lỗi excel không chèn được dòng và không xóa được dòng
Trả lời
2
Đọc
139
Nga1852k
Nga1852k
D
  • Question Question
xin các cao thủ trợ giúp , hoặc nhận làm code có trả phí ạ
Trả lời
14
Đọc
1K
tung1423
tung1423
D
xin hỏi về lỗi mô đun ẩn.
Trả lời
3
Đọc
151
ongke0711
ongke0711
H
Xin anh chị hướng dẫn công thức excel ạ.
Trả lời
9
Đọc
302
Phan Thế Hiệp
Phan Thế Hiệp
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba (1 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
2 3 4
Trả lời
381
Đọc
45K
tuanktt3
T
M
Add-in Excel kết nối cơ sở dữ liệu
Trả lời
1
Đọc
118
ptm0412
ptm0412
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Thời gian đếm ngược.

000
Ngày
00
Giờ
00
phút
00
giây
Thân mời tham dự sự kiện sinh nhật GPE 2025
Back
Top Bottom