İstenilern klasdeki xls belgelerinin A1:ZZ1000 aralığında ÇKS metnini içeren dosyalar

[hsayar]

İstenilern klasdeki xls belgelerinin A1:ZZ1000 aralığında ÇKS metnini içeren dosyaların listesi....

Merhaba excelin içindeki dosya arayı kullanıdım işime yaramadı
Zamanında hazırlşadığım bir dosya var nezamandır ellemediğim için şimdi bulamıyorum yüzlerce dosyayaı açıp incelemekte zor geliyor

Mesala belgelerim klasöründeki xls belgelerinin tüm sayfalarının A1:ZZ1000 aralığında yazılan metni arayacak bir makro varmıdır?

 

[hsayar]

GÜnaydın.
Güncel yardım edebilirseniz sevinirim.

 

[hsayar]

GÜnaydın.
Güncel yardım edebilirseniz sevinirim.

 

[Zeki Gürsoy]

Private Cn   As Object
Private Rs1  As Object
Private Rs2  As Object
Private Cat  As Object
Private s    As String

Private Sub CommandButton1_Click()
Dim f As Object, d As String
Set f = CreateObject("Shell.Application").BrowseForFolder(0, _
    "Taranacak klsörü seçin", 0)

If f Is Nothing Then Exit Sub
TextBox1 = f.items.Item.Path
s = IIf(Right$(TextBox1, 1) = "\", "", "\")
d = Dir(TextBox1 & s & "*.xls")

While d <> ""
    ListBox1.AddItem d
    d = Dir
Wend
End Sub

Private Sub CommandButton2_Click()
Dim t As Object, i As Integer, j As Long

On Error Resume Next

Set Cn = CreateObject("ADODB.Connection")
Set Rs2 = CreateObject("ADODB.Recordset")
Set Cat = CreateObject("ADOX.Catalog")

For i = 0 To ListBox1.ListCount - 1

Cn.Open _
"Driver={Microsoft Excel Driver (*.xls)};DBQ=" & _
            TextBox1 & s & ListBox1.List(i, 0)

Cat.ActiveConnection = Cn
    
    For Each t In Cat.Tables
            
            Set Rs1 = Cn.Execute( _
                "Select * from [" & t.Name & "]")
               
            For j = 0 To Rs1.fields.Count - 1
               
                Set Rs2 = Cn.Execute( _
                        "Select [" & Rs1(j).Name & "] from [" & t.Name & "] " & _
                        "where [" & Rs1(j).Name & "] Like '%" & TextBox2 & "%'")
            
                If Rs2.RecordCount > 0 Then
                    ListBox2.AddItem ListBox1.List(i, 0) & "\" & t.Name
                    Rs2.Close
                    Exit For
                End If
                
                Rs2.Close
            Next j
        
        Rs1.Close
    Next t

Cn.Close
Next i

Set Cat = Nothing
Set Rs1 = Nothing
Set Rs2 = Nothing
Set Cn = Nothing

End Sub

 

[hsayar]

sn anemos hocam alakanız için teşekkür ederim tr(j) name satırına geldiğinde derlemee hatası veriyor. gözatabilirseniz seviniirm.

 

[Zeki Gürsoy]

Çalışan örnek yukarıdaki mesajımda eklidir.

 

[hsayar]

anemos hocam alakanıza teşekkür ederim... yalnız kontrol ederken textbox içeriğini dikkate almıyor klasör içindeki tüm xls belgelerini döküyor.

 

[hsayar]

anemos hocam alakanıza teşekkür ederim... yalnız kontrol ederken textbox içeriğini dikkate almıyor klasör içindeki tüm xls belgelerini döküyor.
yardım edebilirseniz sevinirim.

 

[hsayar]

Sn hocam Amacımı tekrar anlatayım
Bir metni - Seçilen Klasördeki xls belgelerindeki hücrelerde arayacak ve metni içeren Kitap-Sayfa Listboxa ekleyecek (üzerine çift tıkladığımda açarsa fena olomaz) bir program arıyorum. Yardım edebilirseniz gerçekten çok sevineceğim.

 

[Zeki Gürsoy]

Merhaba,

Dosyaları açma ve kapama zamanı uzamaması için ADO ile SQL yürüterek çözüme gitmeyi amaçlamıştım. Ancak Excel, diğer standart veritabanlarında olduğu gibi beklenen sonucu vermedi. Yine de bazı ilavelerle sağlıklı sonuç üretecek çözüm olabilir.

Şu an için dosyaları gizli açarak "Find" işlevini kullanmak daha makul çözüm görünüyor.

 

[hsayar]

umarım isteğimi karşılayacak bir yöntem en kısa zamanda bulunur zeki hocam.... Alakanıoza teşekkür ederim.

 

[hsayar]

güncel yardım edebilirseniz sevinirim.

 

[Zeki Gürsoy]

Bu haliyle sorun çözülmüş görünüyor. Eğer hiç hatalı sonuç vermezse kapalı excel dosyalarında arama eklentisi yapılabilir.

12.03.2008 21:15 => İyileştirme yapıldı.

Private Cn   As Object
Private Rs1  As Object
Private rs2  As Object
Private Cat  As Object
Private s    As String

Private Sub CommandButton1_Click()
Dim f As Object, d As String

Set f = CreateObject("Shell.Application").BrowseForFolder(0, _
    "Taranacak klsörü seçin", 0)

If f Is Nothing Then Exit Sub
TextBox1 = f.Self.Path
s = IIf(Right$(TextBox1, 1) = "\", "", "\")
d = Dir(TextBox1 & s & "*.xls")

While d <> ""
    ListBox1.AddItem d
    d = Dir
Wend
End Sub

Private Sub CommandButton2_Click()
Dim t As Object, i As Integer, j As Integer, a As String

On Error Resume Next

Set Cn = CreateObject("ADODB.Connection")
Set Rs1 = CreateObject("ADODB.Recordset")
Set rs2 = CreateObject("ADODB.Recordset")
Set Cat = CreateObject("ADOX.Catalog")

For i = 0 To ListBox1.ListCount - 1

Cn.Open _
"Driver={Microsoft Excel Driver (*.xls)};DBQ=" & _
            TextBox1 & s & ListBox1.List(i, 0)

Cat.ActiveConnection = Cn
    
    For Each t In Cat.Tables

        If t.Type = "SYSTEM TABLE" Then

            Rs1.Open "Select * from [" & t.Name & "]", Cn, 1, 3
            
            If Rs1.Fields.Count = 1 And Rs1(0).Type = 200 Then GoTo atla
            
            For j = 0 To Rs1.Fields.Count - 1
               a = a & "[" & Rs1(j).Name & "] Like '&#37;" & TextBox2 & "%',"
            Next
            
            a = Replace(StrReverse(Mid$(StrReverse(a), 2, Len(a))), ",", " Or ")
            
            rs2.Open "Select * from [" & t.Name & "] " & _
                        "where " & a, Cn, 1, 3
            
            If rs2.RecordCount > 0 Then _
                    ListBox2.AddItem ListBox1.List(i, 0) & "\" & t.Name
                    
            rs2.Close
atla:
            Rs1.Close

        End If

    Next t

Cn.Close
Next i

Set Cat = Nothing
Set Rs1 = Nothing
Set rs2 = Nothing
Set Cn = Nothing

End Sub

 

[hsayar]

sn Hocam Alakanıza Teşekkür ederim.
Belirtilen klasörün içerisindeki xls belgelerini ve çalışma sayfalarını Aranan Sözcük kısmını dikkate almadan listeye alıyor. ne yapılabilir?