hücredeki ifadeyi klasördeki pdf dosyalarının içinde aramakla ilgili

[hikmetko]

merhaba hocalarım üstatlarım...aşağıdaki makro kodunu bir yerden bulmuştum..
tam istediğim ya da başlıkta dediğim işlemi yapıyor...
a1 hücresindeki ifadeyi klasörde arıyor ve varsa o dosya ile birlikte bir klasör açılıyor...
işte sıkıntım burada, ifadenin olduğu bir dosya olmasa da boş bir klasör açıyor...(olursa zaten sadece dosyanın olduğu bir klasör açılıyor bu güzel ve istediğim şey)
örneğin ben a1 , b1..... birçok hücreyi aynı anda aratan aşağıdaki makroyu çoğalttım ve yazdım...
100 hücredeki ifadeyi aynı anda arıyor ama örneğin 5 ifadenin olduğu dosya varsa bu dosyaların olduğu 5 klasör ile birlikte 95 boş klasör de açılıyor....
bu hem bilgisayarı zorluyor hem de bunları tek tek kapatmak zulüm...
a1 hücresindeki ifadenin olduğu dosya varsa, o dosya ile birlikte bir klasör açılsın
b1 hücresindeki ifadenin olduğu dosya yoksa herhangi bir klasör açılmasın..
c1 hücresindeki ifadenin olduğu dosya varsa, o dosya ile birlikte bir klasör açılsın...gibi tabi hepsi aynı anda oluyor...
bende 100 ayrı klasör açılıyor.....istediğim bu boş klasörleri açmasın...yani ifadenin olmadığı durumda boş klasör olmasın..
dolu klasör açılsın ve ben bunların üstünde işlem yapayım...


Sub Ara()
Rky_aranacak$ = Sayfa1.Range("a1")
Evn_nerede$ = "C:\Users\W111251\Desktop\dosya\"
Call Shell("explorer ""search-ms://query=" & Rky_aranacak & "&crumb=location:" & Evn_nerede & """", vbNormalFocus)
End Sub

 

[hikmetko]

çok güzel bir konu...
yok mu yardımcı olabilecek bir üstat uzman?

 

[hikmetko]

üstatlardan en azından olmaz olur şeklinde bir dönüş alsaydık memnun olurduk, hiç mi okuyan olmadı acaba?

 

[Haluk]

If Not Dir(Evn_nerede$ & Rky_aranacak$, vbDirectory) = vbNullString Then
    Shell "explorer ""search-ms://query=" & Rky_aranacak & "&crumb=location:" & Evn_nerede & """", vbNormalFocus
End If

.

 

[hikmetko]

eyvallah hocam çok teşekkürler cevabınız için..
makroyu aşağıdaki gibi 2 kere düzenledim ama ikisinde de çalışmadı...
yazdığınız kodu makroya ekleyecektim değil mi?

Sub Ara()
Rky_aranacak$ = Sayfa1.Range("a1")
Evn_nerede$ = "C:\Users\E1251\Desktop\klasör"
If Not Dir(Evn_nerede$ & Rky_aranacak$, vbDirectory) = vbNullString Then
Call Shell("explorer ""search-ms://query=" & Rky_aranacak & "&crumb=location:" & Evn_nerede & """", vbNormalFocus)
End If

End Sub

*******************************


Sub Ara()
Rky_aranacak$ = Sayfa1.Range("a1")
Evn_nerede$ = "C:\Users\E1251\Desktop\klasör"
If Not Dir(Evn_nerede$ & Rky_aranacak$, vbDirectory) = vbNullString Then
Shell"explorer ""search-ms://query=" & Rky_aranacak & "&crumb=location:" & Evn_nerede & """", vbNormalFocus
End If

End Sub

 

[Haluk]

"C:\Users\E1251\Desktop\klasör\"

ifadenin sonuna \ koyup deneyin....


.

 

[hikmetko]

yok hocam çalışmıyor..
olan ifade olsa da klasör açmıyor olmayan ifade de olsa klasör açmıyor..
hiçbir durumda bir klasör açmıyor.

 

[Haluk]

Bende çalışıyor, sizdeki durum nedir bilemiyorum...

.

 

[Haluk]

Bir de şöyle deneyin;

Sub Ara()
    Rky_aranacak$ = "*" & Sheets("Sheet1").Range("A1") & "*"
    Evn_nerede$ = "C:\TestFolder\"
    If Not Dir(Evn_nerede$ & Rky_aranacak$, vbDirectory) = vbNullString Then
        Call Shell("explorer ""search-ms://query=" & Rky_aranacak$ & "&crumb=location:" & Evn_nerede$ & """", vbNormalFocus)
    End If
End Sub

Sayfa ismini ve klasörü kendinize göre ayarlayın....

.

 

[hikmetko]

hocam siz Evn_nerede$ ifadesini path olarak kabul edip bu klasörde bir dosya yokmu var mı diye programı çalıştırıyorsunuz sanırım değil mi?

yalnız bu klasörde her zaman dosyalar var zaten...bu klasör sabit duruyor...biz bu klasörde aratıyoruz ve tüm sorgu bu klasör üzerinde çalışıyor...

ben makroyu çalıştırınca yeni bir dosya açılıyor, işte bizim açılan yeni klasörde bir dosya var mı diye sorgulatmamız lazım, doğru mudur?

örneğin, bir arama sonucu açılan klasörün yolu şu şekilde(içinde dosya olan)

search-ms:displayname=klasör%20içindeki%20Arama%20Sonuçları&crumb=System.Generic.String%3Aalıcı-satıcı&crumb=location:C%3A%5CUsers%5CE1251%5CDesktop%5Cklasör

içinde dosya olmayan bir klasörün yolu da şu şekilde,

search-ms:displayname=klasör%20içindeki%20Arama%20Sonuçları&crumb=System.Generic.String%3A(odaklı%20DEĞİL%20talep)&crumb=location:C%3A%5CUsers%5CE1251%5CDesktop%5Cklasör

 

[Haluk]

Klasörün içinde aranan dosya var mı yok mu ... ona bakıyor.

Varsa, pencere açılıyor....

.

 

[hikmetko]

çok denedim ama çalışmadı hocam, eke excelimi ve klasörü ekledim, eğer kontrol edebilirseniz çok sevinirim.
iyi günler

 

[Haluk]

Ben sorunuzu dosya ismi olarak algılamıştım.... Eklediğim IF kontrolu ona yönelikti.

.

 

[hikmetko]

yok hocam, hücredeki ifadeyi klasörde arıyor, o ifadenin geçtiği dosya varsa bir klasör ile birlikte ekrana getiriyor.
Bu durumda yardımcı olursanız sevinirim.
Çok araştırıyorum ama bir türlü ulaşamadım çözüme.
Malum eksik bilgiyle de sürekli patinaj oluyor

 

[Korhan Ayhan]

Merhaba,

Deneyiniz.

Açılan arama klasörünün içindeki dosya sayısını bulmak için @Haluk beyin önerdiği fonksiyonu kullandım. Kendisine desteği için teşekkür ederim.

Option Explicit

#If VBA7 Then
    Private Declare PtrSafe Function SendMessage Lib "user32" Alias "SendMessageA" _
    (ByVal hWnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, lParam As Long) As LongPtr
 
    Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" _
    (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
#Else
    Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
    (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long
  
    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
    (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
#End If

Private Const SC_CLOSE = &HF060&
Private Const WM_SYSCOMMAND = &H112

Private Const EXPLORER_CLASSNAME As String = "CabinetWClass"
'Private Const EXPLORER_CLASSNAME As String = "ExploreWClass"

Sub Test()
    Dim Sleep_Time As Long, Find_Data As Variant, Find_Folder_Path As String
    Dim S1 As Worksheet, My_Data As Variant, X As Long, Last_Row As Long
  
    #If VBA7 Then
        Dim Folder_hWnd As LongPtr
    #Else
        Dim Folder_hWnd As Long
    #End If
    
    Find_Folder_Path = "C:\Users\W111251\Desktop\dosya\"
 
    Set S1 = Sheets("Sayfa1")
 
    Last_Row = WorksheetFunction.Max(2, S1.Cells(S1.Rows.Count, 1).End(3).Row)
 
    My_Data = S1.Range("A1:A" & Last_Row).Value
    
    For X = LBound(My_Data, 1) To UBound(My_Data, 1)
        Find_Data = My_Data(X, 1)
        
        If Find_Data <> "" Then
            Call Shell("explorer ""search-ms://query=" & Find_Data & "&crumb=location:" & Find_Folder_Path & """", vbNormalFocus)
        
            Sleep_Time = Timer
         
            Do
                DoEvents
            Loop Until Timer - Sleep_Time >= 3
        
            Folder_hWnd = FindWindow(EXPLORER_CLASSNAME, vbNullString)
        
            If Get_Count_of_Contents(Folder_hWnd) = 0 Then
                SendMessage Folder_hWnd, WM_SYSCOMMAND, SC_CLOSE, ByVal 0&
            End If
        End If
    Next
End Sub

Function Get_Count_of_Contents(hWnd As Long) As Variant
'   Haluk - 24/08/2022
'   sa4truss@gmail.com
    Dim objShell As Object, myWindow As Object, RetVal As Variant
 
    Set objShell = CreateObject("Shell.Application")
 
    For Each myWindow In objShell.Windows
        On Error Resume Next
            If myWindow.hWnd = hWnd Then
                If Err = 0 Then
                    RetVal = myWindow.Document.Folder.Items.Count
                End If
                Exit For
            End If
        On Error GoTo 0
    Next
    Get_Count_of_Contents = RetVal
End Function

 

[hikmetko]

hocam çok sağolun, kod baya uzun ve anlamakta zorluk çektim.
çalıştırdığımda hata verdi " bu projedeki kodun 64 bit sistemlerde çalışabilmesi için güncellenmesi lazım...declare statements i gözden geçirin ve güncelleyin, sonra da ptrsafe ile işaretleyin..." anlamında...

 

[hikmetko]

64 bit windows10 bilgisayarda excel 2016 yı kullanıyorum

 

[Korhan Ayhan]

Kodda küçük bir revize yaptım. Tekrar deneyiniz.

 

[hikmetko]

FindWindow u işaretleyip Type Mismatch hatası verdi hocam

Folder_hWnd = FindWindow(EXPLORER_CLASSNAME, vbNullString)

 

[Korhan Ayhan]

Kodda aşağıdaki satırı aktif hale getirip bir üstündeki satırı pasif hale getirip deneyiniz. Aktif hale getirmek için başındaki tek tırnak işaretini silmeniz gerekiyor.

'Private Const EXPLORER_CLASSNAME As String = "ExploreWClass"