Merhaba, bir konuda desteğinize ihtiyacım var. "C:\JPG\A" klasörü altında bulunan tüm .jpg ve .bmp dosyalarını listbox1 üzerinde göstermek istiyorum. Fakat bunu yaparken "C:\JPG\A\ klasörü altında bulunan tüm klasörlerde bulunan tüm .jpg ve .bmp dosyalarını da göstermek istiyorum. Yani "C:\JPG\A" klasörü ve alt klasörleri altında bulunan tüm .jpg ve .bmp dosyalarını listbox1 e aktarmak istiyorum. Yardımcı olacak arkadaşlara şimdiden teşekkür ederim.
-
DİKKAT DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Klasör ve alt klasör altında bulunan dosyaları ".jpg,.bmp" göstermek
- Konbuyu başlatan Yusuf98
- Başlangıç tarihi
tugkan
Altın Üye
- Katılım
- 6 Kasım 2004
- Mesajlar
- 445
- Excel Vers. ve Dili
-
Excel 2016
Türkçe 64 BIT
- Altın Üyelik Bitiş Tarihi
- 16-10-2025
VBA ile belirtilen klasör ve alt klasörlerdeki tüm .jpg ve .bmp dosyalarını ListBox1 üzerinde göstermek için, aşağıdaki gibi bir kod kullanabilirsiniz. Bu kod, belirtilen ana klasör ve alt klasörlerdeki dosyaları tarayacak ve uygun dosyaları ListBox1'e ekleyecektir.
Açıklamalar:
Kod:
Sub ListImagesInFolder()
Dim folderPath As String
Dim fileName As String
Dim subFolder As Object
Dim fso As Object
Dim mainFolder As Object
Dim file As Object
' Ana klasör yolunu belirle
folderPath = "C:\JPG\A\"
' FileSystemObject oluştur
Set fso = CreateObject("Scripting.FileSystemObject")
Set mainFolder = fso.GetFolder(folderPath)
' Klasördeki dosyaları tarama
For Each file In mainFolder.Files
' .jpg ve .bmp dosyalarını kontrol et
If LCase(fso.GetExtensionName(file.Name)) = "jpg" Or LCase(fso.GetExtensionName(file.Name)) = "bmp" Then
ListBox1.AddItem file.Path
End If
Next file
' Alt klasörlerdeki dosyaları tarama
For Each subFolder In mainFolder.Subfolders
For Each file In subFolder.Files
' .jpg ve .bmp dosyalarını kontrol et
If LCase(fso.GetExtensionName(file.Name)) = "jpg" Or LCase(fso.GetExtensionName(file.Name)) = "bmp" Then
ListBox1.AddItem file.Path
End If
Next file
Next subFolder
End Sub- folderPath değişkeni, dosyaların bulunduğu ana klasörü belirtir.
- FileSystemObject kullanarak, hem ana klasörün dosyalarını hem de alt klasörlerdeki dosyaları tarayabilirsiniz.
- .jpg ve .bmp uzantılı dosyaları kontrol etmek için LCase ve GetExtensionName fonksiyonları kullanılır.
- Bulunan dosya yolları ListBox1'e eklenir.
Hocam kusura bakmayın. Sorum belki eksikti. Yazdığınız gibi C:\JPG\A altında ve C:\JPG\A\B altında bulunan dosyaları ekledi. Fakat C:\JPG\A\B\C ve daha alt klasör varsa C:\JPG\A\B\C\D gibi burada bulunan dosyaları da listeye alabilir miyiz.
Evet C:\JPG\A altında bulunan tüm alt klasörleri varsa aramaya dahil etsin. C:\JPG\A\B C:\JPG\A\C C:\JPG\A\B\D C:\JPG\A\D\E\K gibi..
tugkan
Altın Üye
- Katılım
- 6 Kasım 2004
- Mesajlar
- 445
- Excel Vers. ve Dili
-
Excel 2016
Türkçe 64 BIT
- Altın Üyelik Bitiş Tarihi
- 16-10-2025
Dener misiniz?
Alt klasörleri de tarayacak şekilde tüm .jpg ve .bmp dosyalarını listelemek için bir özyinelemeli (recursive) fonksiyon kullanabiliriz. Böylece, ana klasörün yanı sıra tüm alt klasörleri de tarayarak istenen dosyaları ListBox1'e eklemiş oluruz.
Aşağıdaki güncellenmiş kodu kullanabilirsiniz:
Açıklamalar:
Alt klasörleri de tarayacak şekilde tüm .jpg ve .bmp dosyalarını listelemek için bir özyinelemeli (recursive) fonksiyon kullanabiliriz. Böylece, ana klasörün yanı sıra tüm alt klasörleri de tarayarak istenen dosyaları ListBox1'e eklemiş oluruz.
Aşağıdaki güncellenmiş kodu kullanabilirsiniz:
Kod:
Sub ListAllImages()
Dim folderPath As String
Dim fso As Object
Dim mainFolder As Object
' Ana klasör yolunu belirtin
folderPath = "C:\JPG\A\"
' FileSystemObject oluştur
Set fso = CreateObject("Scripting.FileSystemObject")
Set mainFolder = fso.GetFolder(folderPath)
' ListBox1 temizleyin
ListBox1.Clear
' Ana klasör ve tüm alt klasörlerdeki dosyaları listeleyen alt yordamı çağır
ListFilesInFolder mainFolder, fso
End Sub
Sub ListFilesInFolder(folder As Object, fso As Object)
Dim file As Object
Dim subFolder As Object
' Geçerli klasördeki dosyaları kontrol et
For Each file In folder.Files
' .jpg ve .bmp dosyalarını kontrol et
If LCase(fso.GetExtensionName(file.Name)) = "jpg" Or LCase(fso.GetExtensionName(file.Name)) = "bmp" Then
ListBox1.AddItem file.Path
End If
Next file
' Alt klasörleri tarayarak özyinelemeli olarak ListFilesInFolder yordamını çağır
For Each subFolder In folder.Subfolders
ListFilesInFolder subFolder, fso
Next subFolder
End Sub- ListAllImages Prosedürü: ListAllImages, ana klasörün yolunu belirleyip FileSystemObject nesnesi oluşturur, ardından ListFilesInFolder adlı özyinelemeli yordamı çağırarak tüm klasörleri tarar.
- ListFilesInFolder Prosedürü: Bu yordam, belirtilen klasördeki dosyaları ve alt klasörleri tarar. .jpg veya .bmp uzantısına sahip dosyaları ListBox1'e ekler ve alt klasörlere girerek işlemi devam ettirir.
- Özyinelemeli Tarama: ListFilesInFolder yordamı, her alt klasör için tekrar kendini çağırır, böylece tüm alt klasörlerdeki dosyalar da taranmış olur.
Hocam bu konuda sizden bir bilgi daha isteyeceğim. Acaba dosyaları listeye aktarırken klasördeki gibi bir sıra ile aktarabilir mi? Bu mümkün müdür? Listeye 1.jpg, 10.jpg, 2.jpg olarak aktarıyor. Fakat ilgili klasörü açtığımda 1.jpg, 2.jpg, 10.jpg olarak bir sıralama var. Listeye aktarırken klasördeki sıralamaya göre bir aktarım olabilir mi?
tugkan
Altın Üye
- Katılım
- 6 Kasım 2004
- Mesajlar
- 445
- Excel Vers. ve Dili
-
Excel 2016
Türkçe 64 BIT
- Altın Üyelik Bitiş Tarihi
- 16-10-2025
Dosyaları klasördeki gibi sıralı bir şekilde ListBox1'e aktarmak için dosyaları listelemeden önce bir koleksiyona veya diziye ekleyip, ardından bu diziyi sıralayarak ListBox1'e ekleyebiliriz. Bu şekilde, dosyalar klasördeki alfabetik veya doğal sıralama ile (yani 1.jpg, 2.jpg, 10.jpg gibi) listelenmiş olur.
Aşağıdaki kod, dosyaları topladıktan sonra doğal bir sıralama yaparak ListBox1'e ekler:
Açıklamalar:
Aşağıdaki kod, dosyaları topladıktan sonra doğal bir sıralama yaparak ListBox1'e ekler:
Kod:
Sub ListAllImagesInOrder()
Dim folderPath As String
Dim fso As Object
Dim mainFolder As Object
Dim fileList As Collection
' Ana klasör yolunu belirtin
folderPath = "C:\JPG\A\"
' FileSystemObject ve dosya listesini oluştur
Set fso = CreateObject("Scripting.FileSystemObject")
Set mainFolder = fso.GetFolder(folderPath)
Set fileList = New Collection
' ListBox1'i temizleyin
ListBox1.Clear
' Ana klasör ve tüm alt klasörlerdeki dosyaları toplayın
CollectFilesInFolder mainFolder, fso, fileList
' Dosya listesini sıralayın
Dim sortedList() As String
sortedList = SortFileList(fileList)
' Sıralanan listeyi ListBox1'e ekleyin
Dim i As Integer
For i = LBound(sortedList) To UBound(sortedList)
ListBox1.AddItem sortedList(i)
Next i
End Sub
Sub CollectFilesInFolder(folder As Object, fso As Object, fileList As Collection)
Dim file As Object
Dim subFolder As Object
' Geçerli klasördeki dosyaları kontrol et
For Each file In folder.Files
' .jpg ve .bmp dosyalarını kontrol et
If LCase(fso.GetExtensionName(file.Name)) = "jpg" Or LCase(fso.GetExtensionName(file.Name)) = "bmp" Then
fileList.Add file.Path
End If
Next file
' Alt klasörlerde özyinelemeli olarak dosya toplayın
For Each subFolder In folder.Subfolders
CollectFilesInFolder subFolder, fso, fileList
Next subFolder
End Sub
Function SortFileList(fileList As Collection) As String()
Dim tempArray() As String
Dim i As Integer
' Dizi boyutunu belirleyin
ReDim tempArray(1 To fileList.Count)
' Koleksiyondan diziye aktarın
For i = 1 To fileList.Count
tempArray(i) = fileList(i)
Next i
' Dosya yollarını sıralayın (alfabetik sıraya göre)
QuickSort tempArray, LBound(tempArray), UBound(tempArray)
' Sıralanmış diziyi döndür
SortFileList = tempArray
End Function
Sub QuickSort(arr() As String, first As Long, last As Long)
Dim pivot As String, tmp As String
Dim i As Long, j As Long
i = first
j = last
pivot = arr((first + last) \ 2)
Do While i <= j
Do While StrComp(arr(i), pivot, vbTextCompare) < 0
i = i + 1
Loop
Do While StrComp(arr(j), pivot, vbTextCompare) > 0
j = j - 1
Loop
If i <= j Then
tmp = arr(i)
arr(i) = arr(j)
arr(j) = tmp
i = i + 1
j = j - 1
End If
Loop
If first < j Then QuickSort arr, first, j
If i < last Then QuickSort arr, i, last
End Sub- ListAllImagesInOrder Prosedürü: Ana klasör ve tüm alt klasörlerdeki .jpg ve .bmp dosyaları toplar, sıralar ve ardından ListBox1'e ekler.
- CollectFilesInFolder Prosedürü: Dosyaları ve alt klasörleri tarayarak uygun dosya yollarını fileList koleksiyonuna ekler.
- SortFileList Fonksiyonu: Dosya listesi koleksiyonunu geçici bir diziye aktarır ve diziyi alfabetik olarak sıralar. QuickSort algoritması kullanılarak sıralama yapılır.
- QuickSort Prosedürü: Diziyi alfabetik sıraya göre sıralar. Böylece 1.jpg, 2.jpg, 10.jpg şeklinde sıralama yapılır.
Hocam çok teşekkürler. Sayenizde yeni şeyler öğrendim. Fakat bir önceki kodlar bana daha uygun. Burda işler karıştı. Çünkü en son attığınız kodlar sanırım tüm klasörlerdeki dosyaları alıyor ve hepsini sıralıyor. Bana ise klasör-klasör alarak sıralama yapması gerekli. Yani ilk klasörü al sırala listeye at. Sonra 2. klasörü al ve sıralayıp listeye at gibi. Dosya yolu (.Path) yerine dosya adı ( .Name) yazdım bu arada.
- Katılım
- 6 Mart 2024
- Mesajlar
- 124
- Excel Vers. ve Dili
- Excel 2010 TR & Excel 2016 TR
Merhaba,
GPT-4,0 dan Alternatif
GPT-4,0 dan Alternatif
C++:
Sub UserForm_Initialize()
Dim mainFolderPath As String
Dim fileSystem As Object
Dim folder As Object
Dim subFolder As Object
Dim file As Object
' Ana klasör yolu
mainFolderPath = "C:\JPG\A"
' ListBox'ı temizle
Me.ListBox1.Clear
' FileSystemObject başlat
Set fileSystem = CreateObject("Scripting.FileSystemObject")
' Ana klasörü belirle
Set folder = fileSystem.GetFolder(mainFolderPath)
' Ana klasördeki tüm dosyaları ve alt klasörleri tarayarak dosyaları ekle
Call ListFilesInFolder(folder, True)
' Temizlik
Set fileSystem = Nothing
End Sub
Private Sub ListFilesInFolder(ByVal folder As Object, ByVal includeSubfolders As Boolean)
Dim file As Object
Dim subFolder As Object
' Bu klasördeki dosyaları kontrol et
For Each file In folder.Files
' Dosya uzantısını kontrol et
If LCase(file.Name) Like "*.jpg" Or LCase(file.Name) Like "*.bmp" Then
' ListBox'a dosya yolunu ekle
Me.ListBox1.AddItem file.Path
End If
Next file
' Alt klasörleri kontrol et (recursive çağrı)
If includeSubfolders Then
For Each subFolder In folder.Subfolders
ListFilesInFolder subFolder, True
Next subFolder
End If
End SubAlternatif için teşekkürler. Klasörü açtığımda klasörde olan dosyaların dizilimi 1.jpg, 2.jpg, 10.jpg, 11.jpg, A.jpg, B.jpg olarak geliyor. Fakat listeye alırken bu dizilimi almıyor. Listeye 1.jpg, 10.jpg, 11.jpg, 2.jpg, A.jpg, B.jpg olarak alıyor. Klasör içerisindeki sıralama ile almak mümkün olur mu?
Yukardaki kodlar da klasördeki gibi Ad sıralamasında verilen sıralamayı vermiyor. Klasördeki Ad sıralaması 1.jpg, 2.jpg, 10.jpg, 11.jpg, A.jpg, B.jpg olarak verirken listede Listeye 1.jpg, 10.jpg, 11.jpg, 2.jpg, A.jpg, B.jpg olarak geliyor. Acaba bir çözüm var mıdır.
- Katılım
- 6 Mart 2024
- Mesajlar
- 124
- Excel Vers. ve Dili
- Excel 2010 TR & Excel 2016 TR
Scripting.FileSystemObject
Ad a göre sıralama yaparken dosya isminde ki her bir karakteri tek tek sıraladığından dolayı
rakamlarında her bir karakterini tek tek sıraladığından bu şekilde gözüküyormuş.
sayılar 1, 10, 100, 101 gibi sıralanırken 2, 3 gibi dosyalar 101'den sonra gelmektedir.
Sizin istediğiniz gibi bir sıralama kodları biraz uzaaaaaaaaayacaktır.
Ad a göre sıralama yaparken dosya isminde ki her bir karakteri tek tek sıraladığından dolayı
rakamlarında her bir karakterini tek tek sıraladığından bu şekilde gözüküyormuş.
sayılar 1, 10, 100, 101 gibi sıralanırken 2, 3 gibi dosyalar 101'den sonra gelmektedir.
Sizin istediğiniz gibi bir sıralama kodları biraz uzaaaaaaaaayacaktır.
C++:
Private Sub UserForm_Initialize()
Dim folder As Object
Dim fileSystem As Object
' Ana klasör yolunu belirleyin
Set fileSystem = CreateObject("Scripting.FileSystemObject")
Set folder = fileSystem.GetFolder("C:\JPG\A")
' ListBox'ı temizleyin
Me.ListBox1.Clear
' Dosyaları ve alt klasörleri listeleyin
ListFilesInFolderByAlphabet folder, True
End Sub
Private Sub ListFilesInFolderByAlphabet(ByVal folder As Object, ByVal includeSubfolders As Boolean)
Dim file As Object
Dim subFolder As Object
Dim fileNames As Collection
Dim sortedFileNames As Collection
Dim fileName As Variant
' Dosyaları collection'a ekleyin
Set fileNames = New Collection
For Each file In folder.Files
If LCase(file.Name) Like "*.jpg" Or LCase(file.Name) Like "*.bmp" Then
fileNames.Add file.Name
End If
Next file
' Sayısal sıralama
Set sortedFileNames = SortFileNamesNumerically(fileNames)
' Sıralı dosyaları ListBox'a ekleyin
For Each fileName In sortedFileNames
Me.ListBox1.AddItem folder.Path & "\" & fileName
Next fileName
' Alt klasörlerdeki dosyaları listele
If includeSubfolders Then
For Each subFolder In folder.SubFolders
ListFilesInFolderByAlphabet subFolder, True
Next subFolder
End If
End Sub
Function SortFileNamesNumerically(fileNames As Collection) As Collection
Dim tempArray() As String
Dim i As Long, j As Long
Dim temp As String
' Collection'ı diziye çevirin
ReDim tempArray(1 To fileNames.Count)
For i = 1 To fileNames.Count
tempArray(i) = fileNames(i)
Next i
' Sayısal sıralama için Bubble Sort kullanıyoruz
For i = 1 To UBound(tempArray) - 1
For j = i + 1 To UBound(tempArray)
If GetNumericValue(tempArray(i)) > GetNumericValue(tempArray(j)) Then
temp = tempArray(i)
tempArray(i) = tempArray(j)
tempArray(j) = temp
End If
Next j
Next i
' Sıralı dosya adlarını yeni bir Collection'a ekleyin
Set SortFileNamesNumerically = New Collection
For i = 1 To UBound(tempArray)
SortFileNamesNumerically.Add tempArray(i)
Next i
End Function
Function GetNumericValue(fileName As String) As Long
Dim numericValue As String
Dim i As Long
' Dosya adındaki sayıyı ayıklayın
For i = 1 To Len(fileName)
If Mid(fileName, i, 1) Like "#" Then
numericValue = numericValue & Mid(fileName, i, 1)
End If
Next i
' Sayısal değeri döndür
GetNumericValue = IIf(numericValue <> "", CLng(numericValue), 0)
End FunctionHocam sonuç biraz daha yakın oldu. Sayısal değerleri sıraladı. Fakat Listeyi B.jpg, A.jpg, 1.jpg, 2.jpg, 10.jpg, 11.jpg olarak listeledi. Klasördeki gösterim 1.jpg, 10.jpg, 11.jpg, 2.jpg, A.jpg, B.jpg gibi sıralamadı.
Hocam yanlış yazdım. Sayısal değerleri sıraladı. B.jpg, A.jpg, 1.jpg, 2.jpg, 10.jpg, 11.jpg olarak listeledi. Klasördeki gösterim 1.jpg, 2.jpg, 10.jpg, 11.jpg, A.jpg, B.jpg gibi sıralamadı.
- Katılım
- 6 Mart 2024
- Mesajlar
- 124
- Excel Vers. ve Dili
- Excel 2010 TR & Excel 2016 TR
Dosya isimleri gerçekten böylemi 
GPT-4 Böyle bişiler üretti
GPT-4 Böyle bişiler üretti
C++:
Private Sub UserForm_Initialize()
Dim folder As Object
Dim fileSystem As Object
' Ana klasör yolunu belirleyin
Set fileSystem = CreateObject("Scripting.FileSystemObject")
Set folder = fileSystem.GetFolder("C:\JPG\A")
' ListBox'ı temizleyin
Me.ListBox1.Clear
' Dosyaları ve alt klasörleri listeleyin
ListFilesInFolderByAlphabet folder, True
End Sub
Private Sub ListFilesInFolderByAlphabet(ByVal folder As Object, ByVal includeSubfolders As Boolean)
Dim file As Object
Dim subFolder As Object
Dim fileNames As Collection
Dim sortedFileNames As Collection
Dim fileName As Variant
' Dosyaları collection'a ekleyin
Set fileNames = New Collection
For Each file In folder.Files
If LCase(file.Name) Like "*.jpg" Or LCase(file.Name) Like "*.bmp" Then
fileNames.Add file.Name
End If
Next file
' Sayısal sıralama yap
Set sortedFileNames = SortFileNamesNumerically(fileNames)
' Sıralı dosyaları ListBox'a ekleyin
For Each fileName In sortedFileNames
Me.ListBox1.AddItem folder.Path & "\" & fileName
Next fileName
' Alt klasörlerdeki dosyaları listele
If includeSubfolders Then
For Each subFolder In folder.SubFolders
ListFilesInFolderByAlphabet subFolder, True
Next subFolder
End If
End Sub
Function SortFileNamesNumerically(ByRef fileNames As Collection) As Collection
Dim tempArray() As String
Dim i As Long, j As Long
Dim temp As String
Dim sortedCollection As New Collection
' Collection'ı diziye çevirin
ReDim tempArray(1 To fileNames.Count)
For i = 1 To fileNames.Count
tempArray(i) = fileNames(i)
Next i
' Sayısal sıralama için Bubble Sort kullanıyoruz
For i = 1 To UBound(tempArray) - 1
For j = i + 1 To UBound(tempArray)
' Sayısal değeri karşılaştırmak için GetNumericValue kullanıyoruz
If GetNumericValue(tempArray(i)) > GetNumericValue(tempArray(j)) Then
temp = tempArray(i)
tempArray(i) = tempArray(j)
tempArray(j) = temp
End If
Next j
Next i
' Sıralı dosya adlarını yeni bir Collection'a ekleyin
For i = 1 To UBound(tempArray)
sortedCollection.Add tempArray(i)
Next i
' Sorted Collection'ı geri döndür
Set SortFileNamesNumerically = sortedCollection
End Function
Function GetNumericValue(fileName As String) As Long
Dim numericValue As String
Dim i As Long
Dim isNumeric As Boolean
numericValue = ""
' Dosya adındaki sayıyı ayıklayın
For i = 1 To Len(fileName)
' Sayıyı bulup numericValue'ya ekleyin
If Mid(fileName, i, 1) Like "#" Then
numericValue = numericValue & Mid(fileName, i, 1)
End If
Next i
' Sayısal değeri döndür, eğer yoksa 0 döndür
If numericValue <> "" Then
GetNumericValue = CLng(numericValue)
Else
' Sayısal bir değer yoksa, alfabetik dosya adları için uzunluklarını kullanabiliriz
' Örneğin, A.jpg -> A'ya göre sıralama yapabilmek için
GetNumericValue = 9999999 ' Bu sayı alfabetik dosyaların en sonuna yerleşmesi için yüksek bir değer
End If
End Function- Katılım
- 6 Mart 2024
- Mesajlar
- 124
- Excel Vers. ve Dili
- Excel 2010 TR & Excel 2016 TR
Bundan sonrasını GPT-4 den siz devam edebilir veya
forumdan başka arkadaşlar yardımcı olabilirler.