Klasör içindeki dosyaların adlarına göre arama

[iaslan517]

Merhabalar, ekteki dosyada ana excel var. A sütünundaki isimler aynı klasörde bulunan pdflerin adları. yaklaşık 5000 kalemden oluşan bir listemiz var. o listedeki isimleri klasörde arayıp. o klasörde var ise kaşısına var yazdırabilirmiyiz? (klasör içindeki dosyalarıda arayacak)

 

[netcini]

Sanırım sorununuzu şu şekilde çözebilirsiniz.

Öncelikle Asap Utilty eklentisini indirip kurun

http://www.asap-utilities.com/download-asap-utilities.php
Home and Student edition, ücretsiz.
Eğer iş bilgisayarınızda kullanacaksanız. İş sürümü de 90 gün deneme süreli.
İşiniz bitince silersiniz.

Eklentiyi aktif edip exceli çalıştırdığınızda Asap Ribbonun da sanırım File & System menüsünde directory ve dosya listeleme makrosu var.
Seçtiğiniz klasördeki dosya isimlerini excele aktarıyor.
Bu linkten nasıl yapıldığına bakabilirsiniz. (Inculude subfolder seçerseniz alt klasörleri de listeler)
http://www.asap-utilities.com/asap-utilities-excel-tools-tip.php?tip=115&utilities=104

Excele dosya isimlerini aldıktan sonra. Kendi listenizle düşeyara yaparak karşılaştırır ve klasörlerde bulunan dosyaları tesbit edebilirsiniz.

 

[bkts34]

Merhaba,

Dosyanızı indiremedim ancak Sayın netcini nin önderdiği gibi bir yol denemek isterseniz herhangi bir eklenti indirmeden aşağıda ki kodu bir modüle ekleyerek çalıştırıp seçtiğiniz klasörde ki dosya isimlerini excele alarak düşeyara yapabilirsiniz,

Sub dosya_isimleri()
Set klasorsec = CreateObject("Shell.Application").BrowseForFolder(0, "Lütfen bir klasör seçin !", &H100)
yol = klasorsec.Items.Item.Path
Set nesne = CreateObject("Scripting.FileSystemObject")
Set klasor = nesne.GetFolder(yol)
Set dosyalar = klasor.Files
Worksheets.Add
For Each dosya In dosyalar
c = c + 1
Cells(c, "a") = Replace(dosya.Name, "." & nesne.GetExtensionName(dosya.Name), "")
Next
End Sub

 

[netcini]

Sayın bkts34, alt klasörlerdeki dosya isimlerini, klasör adlarıyla beraber almanın bir yolu var mıdır ?

Geçenlerde alt klasörlerle beraber dosya isimlerine de ihtiyacım olduğunda, Asap Utilty ile almıştım.

İleride ihtiyacım olursa sizin kodlarınızı kullanabilirim.

 

[Asri]

Merhabalar, ekteki dosyada ana excel var. A sütünundaki isimler aynı klasörde bulunan pdflerin adları. yaklaşık 5000 kalemden oluşan bir listemiz var. o listedeki isimleri klasörde arayıp. o klasörde var ise kaşısına var yazdırabilirmiyiz? (klasör içindeki dosyalarıda arayacak)

Alternatif;

Aşağıdaki şekilde deneyiniz. dosya isimleri tam yazılmalıdır. KB123456.txt gibi

C:\Deneme ana klasördür.

Sub Dosya_Kontrol()
  Dim ds, f
  Set ds = CreateObject("Scripting.FileSystemObject")
  Set f = ds.GetFolder("c:\deneme")
  sonsatir = Cells(Rows.Count, "A").End(3).Row
  For i = 1 To sonsatir
    dosya = Cells(i, 1).Value
    For Each klas In f.subfolders
      If ds.FileExists(klas & "\" & dosya) Then
         Cells(i, 3).Value = "Var"
      End If
    Next
  Next i
End Sub

 

[bkts34]

Merhaba,

Sayın Murat OSMA hocamızdan aldığım ve uyarlamaya çalıştığım aşağıda ki kod ile açılır pencereden seçilen ana klasörün içi ve alt klasörleri tarayarak pdf uzantılı olan dosyaların isimleri alınabiliyor. Bende hali hazırda bu kod bulunuyor, umarım işinize yarar, iyi akşamlar.

Public Fso As Object, Evn As Object, Dosya As Object
Public Klasörler As Object, Sat As Long

Sub Dizindeki_Tüm_Klasörleri_Tara()
On Error Resume Next
Set klasorsec = CreateObject("Shell.Application").BrowseForFolder(0, "Lütfen bir klasör seçin !", &H100)
yol = klasorsec.Items.Item.Path
If yol = "" Then
MsgBox "Dosya seçme işleminden vazgeçildi"
Exit Sub
End If


    Call Ara(yol)
    Set Fso = Nothing: Set Evn = Nothing: Sat = Empty
    Set Dosya = Nothing: Set Klasörler = Nothing
End Sub

Public Function Ara(ByVal Dizin As String)
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set Evn = Fso.GetFolder(Dizin): Ara = 0
    For Each Klasörler In Evn.Subfolders
        For Each Dosya In Evn.Files
            If Right(Dosya.Name, 4) = ".pdf" Then
                Sat = Sat + 1
                Cells(Sat, 1).Value = Dosya.Name
            End If
        Next Dosya
        Ara = Ara + 1 + Ara(Klasörler.Path)
    Next Klasörler
End Function

 

[netcini]

İyi akşamlar Sayın bkts34.
Kodları alıp arşivme atıyorum. Size ve Sayın Murat OSMA hocama Teşekkürler. Allah Razı olsun sizlerden