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

[tahsinanarat]

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]

Sevgili hocalarım konu güncel, bu konuda bir fikri olan varsa yazsın lütfen.

 

[tahsinanarat]

Konu günceldir arkadaşlar

 

[Korhan Ayhan]

Bu linkte Haluk beyin önerdiği yapıyı kendinize uyarlamanız gerekir.

Çözüldü - ağdaki klasör ve alt klasörleri excel'de listeleme

Merhabalar. Ağda ya da belli bir dizinde bulunan klasör ve bu klasörlerin içerisinde alt alta oluşturulmuş dizinlerdeki tüm klasör isimlerini listeleyecek kod oluşturulabilir mi acaba? Dizinde iç içe 20 den fazla alt klasör var. Forum da ve nette bulduklarımın bazıları 3 klasöre kadar getiriyor...

www.excel.web.tr

 

[Haluk]

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....

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

.

 

[tahsinanarat]

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]

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.

 

[tahsinanarat]

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.

 

[Korhan Ayhan]

Merhaba,

@tahsinanarat bende bahsettiğiniz uyarı çıkmıyor. Netten biraz rştırınca aşğıdaki linke ulaştım. İnceleyip deneyebilirsiniz.


Office belgelerinde dış içeriği engelleme veya serbest bırakma