Bu yazımızda, klasör içindeki tüm dosyaları listelemek için bir makro oluşturacağız.
Makroyu çalıştırırken, dosya yolu ile birlikte dosya adı A17 hücresinden başlayarak görüntülenecektir.
Mantıksal açıklama
Bu yazımızda “subfolder_files” ve “getting_filelist_in_folder” olmak üzere iki makro oluşturduk.
“subfolder_files” makrosu, klasör yolunu ve boole değerini girdi olarak alır ve klasör içindeki dosya adını döndürür.
"alt klasör_dosyaları" makrosunu çağırmak için "getting_filelist_in_folder" kullanılır. Boole değeri 'true' olarak ayarlanarak makroya klasör yolu değerini sağlar. Ayrıca, alt klasörlerdeki dosya adları gerektiğinde, 'true' boolean değeri atarız.
Kod açıklaması
folder_path = Sheet1.TextBox1.Value
Yukarıdaki kod, metin kutusundan dize değerini çıkarmak için kullanılır.
subfolder_files(folder_path, True) çağırın
Yukarıdaki kod “subfolder_files” makrosunu çağırmak için kullanılır. Klasör yolunu atar ve “include_subfolder” özelliğini true olarak ayarlar.
Set fso = CreateObject("scripting.filesystemobject")
Yukarıdaki kod, dosya sisteminin nesnesini oluşturmak için kullanılır.
alt klasör1'i ayarla = fso.getfolder(klasör_yolu)
Yukarıdaki kod, tanımlanan klasörün nesnesini oluşturmak için kullanılır.
Her klasör için1 alt klasörde1.alt klasörlerde
subfolder_files(klasör1, Doğru) çağırın
Sonraki
Yukarıdaki kod, ana klasör içindeki tüm alt klasörlere bakmak için kullanılır.
Dir(klasöryolu1 & "*.xlsx")
Yukarıdaki kod, excel dosya adını almak için kullanılır.
Dosya adı "" iken
say1 = say1 + 1
ReDim Koru filearray(1 Saymak1)
filearray(count1) = dosya adı
dosya adı = Dir()
Wend
Yukarıdaki kod, klasör içinde bulunan tüm dosya adlarından oluşan bir dizi oluşturmak için kullanılır.
i = 1 için UBound(filearray) için
Cells(lastrow, 1).Value = folderpath1 & filearray(i)
son satır = son satır + 1
Sonraki
Yukarıdaki kod, dizi içindeki dosya adını çalışma kitabına atamak için kullanılır.
Lütfen kod için aşağıdan takip edin
Seçenek Explicit Sub subfolder_files(folderpath1 As Variant, Opsiyonel include_subfolder As Boolean) 'Alt klasörün dahil edilip edilmeyeceği kontrol ediliyorsa include_subfolder Sonra 'Değişkenleri bildiriyor Dim filename, filearray() As String Dim lastrow, count1, i As Integer 'Klasör yolunun içerip içermediğini kontrol etme son karakter olarak ters eğik çizgi If Right(folderpath1, 1) "\" Then folderpath1 = folderpath1 & "\" End If 'Tanımlanan klasör yolundaki ilk dosyanın dosya adını alma filename = Dir(folderpath1 & "*.xlsx") ' Son hücrenin satır numarasını alma lastrow = ActiveCell.SpecialCells(xlCellTypeLastCell).Row + 1 count1 = 0 'Dosya adı "" count1 = count1 + 1 ReDim Preserve filearray(1 To count1) filearray( count1) = filename filename = Dir() Wend On Error Son 'Çalışma kitabına dosya adı ekleme For i = 1 To UBound(filearray) Cells(lastrow, 1).Value = folderpath1 & filearray(i) lastrow = lastrow + 1 Next Sonuncuysa Bitir: Sub Sub get_filelist_in_folder'ı Sonlandır () 'Değişkenleri bildirme Dim folder_path As String Dim fso As Object, folder1, subfolder1 As Object ' folder_path = Sheet1.TextBox1.Value klasörünün yolunu alma 'Klasör yolunun son karakter olarak ters eğik çizgi içerip içermediğini kontrol etme Sağsa(folder_path, 1) " \" Sonra folder_path = folder_path & "\" End If 'Subfolder_files makrosu çağrılıyor subfolder_files(folder_path, True) 'Dosya sistemi nesnesinin nesnesi oluşturuluyor Set fso = CreateObject("scripting.filesystemobject") Alt klasör1 ayarla = fso.getfolder(folder_path) 'Her alt klasörde dolaşmak Her klasör için1 subfolder1.subfolders'da subfolder_files(klasör1, True) öğesini arayın Sonraki Son Alt
Bu blogu beğendiyseniz, Facebook'ta arkadaşlarınızla paylaşın. Ayrıca bizi Twitter ve Facebook'ta da takip edebilirsiniz.
Sizden haber almayı çok isteriz, işimizi nasıl geliştirebileceğimizi ve sizin için nasıl daha iyi hale getirebileceğimizi bize bildirin. E-posta sitesinde bize yazın