Bu yazımızda bir klasör içerisindeki tüm dosyaların detaylarını toplamak için bir makro oluşturacağız.
Makroyu çalıştırmadan önce, metin kutusunda klasörün yolunu belirtmemiz gerekiyor.
Makroyu çalıştırırken, klasör içindeki tüm dosyaların Dosya adını, Dosya yolunu, Dosya boyutunu, Oluşturma tarihini ve son değiştirilme tarihini döndürür.
Mantıksal açıklama
Bu yazımızda “ListFilesInFolder” ve “TestListFilesInFolder” olmak üzere iki makro oluşturduk.
“ListFilesInFolder” makrosu, klasör içindeki tüm dosyalarla ilgili ayrıntıları görüntüler.
“TestListFilesInFolder” makrosu, başlığı belirtmek ve “ListFilesInFolder” makrosunu çağırmak için kullanılır.
Kod açıklaması
FSO'yu ayarla = CreateObject("Scripting.FileSystemObject")
Yukarıdaki kod, dosya sistemi nesnesinin yeni bir nesnesini oluşturmak için kullanılır.
SourceFolder = FSO.GetFolder(SourceFolderName) olarak ayarlayın
Yukarıdaki kod, yol tarafından belirtilen klasörün bir nesnesini oluşturmak için kullanılır.
Cells(r, 1).Formula = DosyaItem.Adı
Cells(r, 2).Formula = FileItem.Path
Cells(r, 3).Formula = FileItem.Size
Cells(r, 4).Formula = FileItem.DateCreated
Cells(r, 5).Formula = FileItem.DateLastModified
Yukarıdaki kod, dosyaların ayrıntılarını çıkarmak için kullanılır.
SourceFolder.SubFolders İçindeki Her Alt Klasör İçin
'Alt klasörler için aynı prosedürü çağırmak
ListFilesInFolder SubFolder.Path, True
Sonraki Alt Klasör
Yukarıdaki kod, alt klasörlerdeki tüm dosyaların ayrıntılarını çıkarmak için kullanılır.
Sütunlar("A:E").Seçin
Selection.ClearContents
Yukarıdaki kod, A sütunundan E'ye kadar olan içeriği silmek için kullanılır.
Lütfen kod için aşağıdan takip edin
Seçenek Explicit Sub ListFilesInFolder(ByVal SourceFolderName As String, ByVal IncludeSubfolders As Boolean) 'Değişkenleri bildirme Dim FSO As Object Dim SourceFolder As Object Dim SubFolder As Object Dim FileItem As Object Dim r As Long 'Creating object of FileSystemObject .FileSystemObject") SourceFolder = FSO.GetFolder(SourceFolderName) r = Range("A65536").End(xlUp).Row + 1 SourceFolder'daki Her FileItem için ayarlayın.Files 'Dosya özelliklerini görüntüle Cells(r, 1).Formula = FileItem.Name Cells(r, 2).Formula = FileItem.Path Cells(r, 3).Formula = FileItem.Size Cells(r, 4).Formula = FileItem.DateCreated Cells(r, 5).Formula = FileItem. DateLastModified r = r + 1 Next FileItem 'IncludeSubfolders ise Sonra SourceFolder.SubFolders'daki Her Alt Klasör İçin Alt klasörlerdeki dosyaları alma 'Alt klasörler için aynı prosedürü çağırma ListFilesInFolder SubFolder.Path, True Sonraki AltKlasör FileItem Ayarlanırsa Sonu = Hiçbir Şey Ayarlanmadı SourceFolder = Hiçbir Şey Ayarlanmadı FSO = Hiçbir şey ActiveWorkbook.Saved = Doğru End Sub Sub TestListFilesInFolder() 'Dim FolderPath değişkenini Dize Olarak Bildirme' Ekran güncellemelerini devre dışı bırakma Application.ScreenUpdating = False 'Metin kutusundan klasör yolunu alma FolderPath = Sheet1.TextBox1.Value ActiveSheet.Activate 'İçeriği A:E Sütunlarından temizleme ("A:E").Seçimi Seçin.ClearContents 'Üstbilgi ekleme Range("A14").Formül = "Dosya Adı:" Aralık("B14").Formül = "Yol:" Aralık("C14").Formül = "Dosya Boyutu:" Range("D14").Formula = "Oluşturma Tarihi:" Range("E14").Formula = "Son Değiştirilme Tarihi:" 'Başlıkların Biçimlendirilmesi Range("A14:E14").Font .Bold = True 'ListFilesInFolder makrosunu çağırıyor ListFilesInFolder FolderPath, True 'Sütunların boyutunu otomatik olarak ayarlıyor Columns("A:E").Select Selection.Columns.AutoFit Range("A1").End Sub öğesini seçin
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
