klasör içinde klasör bulma ve içindeki jpg leri listeleme

[bogachanka]

Merhaba,

Forumda yeniyim. Benim bir arşivim var.

Bu arşivde klasörler belli bir formatta , belirli bir klasörü aratıp ( bu klasör isminden çok fazla var ) , onun içerisindeki jpg dosyayı listeleyip köprülemek istiyorum.Forumda aradım ama benzer bir kod görmedim.

her klasörde a,b,c alt klasörleri var. Bana sadece b klasörlerinin içerisindeki jpg lazım. Umarım anlatabilmişimdir.

ör : klasör1
a
b
c

klasör2
a
b
c

.
.
.
.
.
.

 

[halit3]

Bu kod klasördeki jpg uzuntılı dosyaları listeliyor.

Sub dosyalarılitele()
Set Klasor = CreateObject("shell.application").BrowseForFolder(0, "Kaynak Dosyaları İçeren Klasörü Seçin", 50, &H0)
If Not Klasor Is Nothing Then
Kaynak = Klasor.self.Path
If InStr(1, Kaynak, "{") > 0 Then GoTo Atla
Worksheets(ActiveSheet.Name).Range("A2:B" & Rows.Count).ClearContents
Worksheets(ActiveSheet.Name).Range("D2:D" & Rows.Count).ClearContents

Liste1 (Kaynak)

Set Klasor = Nothing
MsgBox "işlem tamam"
Else
Atla:
MsgBox "Lütfen Kaynak Klasör Seçimini Yapınız !", vbInformation, "DİKKAT"
End If
End Sub



Private Sub Liste1(yol As String)
Dim fL As Object, fs As Object, f As Object, j As Long
Set fL = CreateObject("Scripting.FileSystemObject")

For Each Dosya In fL.GetFolder(yol).Files
j = WorksheetFunction.CountA(Worksheets(ActiveSheet.Name).Range("A1:A" & Rows.Count)) + 1
If UCase(fL.GetExtensionName(Dosya)) = "JPG" Then
Cells(j, 1) = Dosya
Cells(j, 2) = fL.GetBaseName(Dosya.Name)
End If
Next

On Error GoTo sonraki
For Each f In fL.GetFolder(yol).subfolders
Liste1 (f.Path)
sonraki:
Next

End Sub

 

[bogachanka]

Bu kod klasördeki jpg uzuntılı dosyaları listeliyor.

Sub dosyalarılitele()
Set Klasor = CreateObject("shell.application").BrowseForFolder(0, "Kaynak Dosyaları İçeren Klasörü Seçin", 50, &H0)
If Not Klasor Is Nothing Then
Kaynak = Klasor.self.Path
If InStr(1, Kaynak, "{") > 0 Then GoTo Atla
Worksheets(ActiveSheet.Name).Range("A2:B" & Rows.Count).ClearContents
Worksheets(ActiveSheet.Name).Range("D2:D" & Rows.Count).ClearContents

Liste1 (Kaynak)

Set Klasor = Nothing
MsgBox "işlem tamam"
Else
Atla:
MsgBox "Lütfen Kaynak Klasör Seçimini Yapınız !", vbInformation, "DİKKAT"
End If
End Sub



Private Sub Liste1(yol As String)
Dim fL As Object, fs As Object, f As Object, j As Long
Set fL = CreateObject("Scripting.FileSystemObject")

For Each Dosya In fL.GetFolder(yol).Files
j = WorksheetFunction.CountA(Worksheets(ActiveSheet.Name).Range("A1:A" & Rows.Count)) + 1
If UCase(fL.GetExtensionName(Dosya)) = "JPG" Then
Cells(j, 1) = Dosya
Cells(j, 2) = fL.GetBaseName(Dosya.Name)
End If
Next

On Error GoTo sonraki
For Each f In fL.GetFolder(yol).subfolders
Liste1 (f.Path)
sonraki:
Next

End Sub

Merhaba ,öncelikle ilginiz için teşekkürler. Arşivimde çok fazla klasör var ve hepsinin içinde jpg var. Benim istediğim belli bir klasör adı altındaki jpgleri çekmek. Şöyle izah edeyim. Arşiv içinde 500 adet alt klasör var ve hepsinin içinde 'b' isminde klasör var. Ben sadece 'b' kalsörünün içindeki jpg leri listelemek ve köprülemek istiyorum.

 

[halit3]

Merhaba geri dönüşünüz tam bir hafta olmuş ben ne yaptığımı da unuttum.

 

[Haluk]

Merhaba geri dönüşünüz tam bir hafta olmuş ben ne yaptığımı da unuttum.

Doğru söze ne denir başka .....

.