Çift tıklama ile alt klasörlerdeki içeren pdf dosyalarını açma

tahsinanarat

Altın Üye
Katılım
14 Mart 2005
Mesajlar
2,164
Excel Vers. ve Dili
Ofis 2019 Türkçe
Altın Üyelik Bitiş Tarihi
27-05-2028
Kod:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
On Error Resume Next
    If Target.Column <> 1 And Target.Column <> 10 And Target.Column <> 11 Or Target.Value = "" Then Exit Sub
    Cancel = True

    pth = "C:\Users\tahsin.anarat\Documents\HCP Anywhere\Tahsin_anarat\"
'    pth = "C:\Users\tahsin.anarat\Documents\HCP Anywhere\Tahsin_anarat\irsaliyeler\"

    fname = pth & "*" & Target.Value & "*.pdf"
    dosya = Dir(fname)
    If dosya <> "" Then
        dosya = pth & dosya
        ActiveWorkbook.FollowHyperlink dosya
    Else
    End If

End Sub
Yukarıdaki kod ile;
pth = "C:\Users\tahsin.anarat\Documents\HCP Anywhere\Tahsin_anarat\irsaliyeler\"
adresindeki a sutununda belirtilen irsaliye numarasına çift tıkladığımda pdf dosyasını açabiliyorum. Buraya kadar hiç bir sıkıntı yok.

Benim istediğim
pth = "C:\Users\tahsin.anarat\Documents\HCP Anywhere\Tahsin_anarat\"
adresinde alt klasörlere de bakımp irsaliyer klasöründeki (Tahsin_anarat adresindeki başka bir alt klasörde de olabilir, alt klasörde başka bir klasördede olabilir) ilgili PDF dosyasını açmak istiyorum.
Alt klasörlerede bakıp açabilmesi için kodda nasıl bir değişiklik olmalıdır.
Üstatlarımdan yardım bekliyorum.
Saygılarımla
 

tahsinanarat

Altın Üye
Katılım
14 Mart 2005
Mesajlar
2,164
Excel Vers. ve Dili
Ofis 2019 Türkçe
Altın Üyelik Bitiş Tarihi
27-05-2028
Sevgili hocalarım konu güncel, bu konuda bir fikri olan varsa yazsın lütfen.
 

tahsinanarat

Altın Üye
Katılım
14 Mart 2005
Mesajlar
2,164
Excel Vers. ve Dili
Ofis 2019 Türkçe
Altın Üyelik Bitiş Tarihi
27-05-2028
Konu günceldir arkadaşlar
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,247
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Bu linkte Haluk beyin önerdiği yapıyı kendinize uyarlamanız gerekir.

 

Haluk

Özel Üye
Katılım
7 Temmuz 2004
Mesajlar
12,406
Excel Vers. ve Dili
64 Bit 2010 - İngilizce
+
Google Sheets
+
JScript
Altın Üyelik Bitiş Tarihi
Alternatif olarak API kullanılabilir.

Aşağıdaki kod, sayfa modülüne yerleştirildikten sonra A1:A10 aralığında herhangibir hücreye çift tıklandığında; çift tıklanan hücrenin içindeki veriyi PDF dosya adı olarak kabul eder, sonuna ".pdf" ekledikten sonra C:\TestFolder klasörü ve tüm alt klasörlerinde bu PDF dosyasını arar. Dosyayı bulursa açar, bulamazsa mesajla ikaz eder.

For-Next veya başka tür döngülerle Excel'i yormamak için, daha kullanışlıdır....

C#:
Private Declare PtrSafe Function SearchTreeForFile Lib "imagehlp" (ByVal RootPath As String, ByVal InputPathName As String, ByVal OutputPathBuffer As String) As Long
Private Const MAX_PATH = 260
'
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim tempStr As String, topFolder As String, Ret As Long, pdfFile As String
   
    tempStr = String(MAX_PATH, 0)
   
    topFolder = "C:\TestFolder"
   
    If (Not Intersect(Target, Range("A1:A10")) Is Nothing) Then
        If Target = Empty Then Exit Sub
        Ret = SearchTreeForFile(topFolder, Target & ".pdf", tempStr)
       
        If Ret <> 0 Then
            pdfFile = Left$(tempStr, InStr(1, tempStr, Chr$(0)) - 1)
            ActiveWorkbook.FollowHyperlink pdfFile
        Else
            MsgBox "Dosya bulunamadı!"
        End If
    End If
End Sub
.
 
Son düzenleme:

tahsinanarat

Altın Üye
Katılım
14 Mart 2005
Mesajlar
2,164
Excel Vers. ve Dili
Ofis 2019 Türkçe
Altın Üyelik Bitiş Tarihi
27-05-2028
Sn. @Haluk hocam, elinize ve zihninize sağlık, çok teşekkür ediyorum. Herkes için çok faydalı bir kod olduğuna inanıyorum. Hakkınızı helal edin.
Saygılar.
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,247
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Ekte bahsettiğim linkteki döngü ile arama kodlarının örnek dosyaya uyarlanmış hali bulunmaktadır.

Forumun arşivinde alternatif olarak bulunması açısından paylaşıyorum.
 

Ekli dosyalar

tahsinanarat

Altın Üye
Katılım
14 Mart 2005
Mesajlar
2,164
Excel Vers. ve Dili
Ofis 2019 Türkçe
Altın Üyelik Bitiş Tarihi
27-05-2028
Sn. @Korhan Ayhan hocam, elinize sağlık, güzel çalışıyor, açılışta ekli resimde gönderdiğim uyarıyı olmadan açtırabilirsek daha da güzel olur.

Çok teşekkürler.
 

Ekli dosyalar

Üst