Soru Klasör altındaki dosyalara köprü ekleyen kodda yöntem değiştirme

[KYenerSelvi]

Aşağıdaki kod için excelimde 2 ayrı buton var. G1 hücresinde bir dosya klasör yolu oluşturuyorum. Bu yol sürekli değişebiliyor. Kopyala butonuna basıp daha sonra çalıştır butonuna bastığımda dosya seçme ekranına yolu yapıştırıyorum.

İstediğim şöyle birşey arkadaşlar, G1 hücresini kopyalamak için ayrı bir fonksiyon yazmak yerine Example1 koduna nasıl entegre edebiliriz. Example1 makrosunu çalıştırdığımda dosya yolu olarak g1 hücresindeki dosya yolunu almış olsun.

A1 hücresinden başlayıp aşağıya kadar klasördeki tüm dosyaları yolları ile köprü ekleyip oluşturuyor. Koda ekleyebilirmiyiz acaba A1 den değilde B3 den itibaren aşağıya kadar yapıştırsın

Sub copyfekler()
Sheets("FF").Range("G1").copy
End Sub

Sub Example1()
    Dim xFSO As Object
    Dim xFolder As Object
    Dim xFile As Object
    Dim xFiDialog As FileDialog
    Dim xPath As String
    Dim I As Integer
    Set xFiDialog = Application.FileDialog(msoFileDialogFolderPicker)
    If xFiDialog.Show = -1 Then
        xPath = xFiDialog.SelectedItems(1)
    End If
    Set xFiDialog = Nothing
    If xPath = "" Then Exit Sub
    Set xFSO = CreateObject("Scripting.FileSystemObject")
    Set xFolder = xFSO.GetFolder(xPath)
    For Each xFile In xFolder.Files
        I = I + 1
        ActiveSheet.Hyperlinks.Add Cells(I, 1), xFile.Path, , , xFile.Name
    Next
End Sub

 

[AdemCan]

Merhaba, klasör seçme işlemi olmadan, G1 hücresinde yazılı olan yol bilgisine göre işlem yapan kodlar.

Sub Example1()
    Dim xFSO As Object
    Dim xFolder As Object
    Dim xFile As Object
    Dim xFiDialog As FileDialog
    Dim xPath As String
    Dim I As Integer
'    Set xFiDialog = Application.FileDialog(msoFileDialogFolderPicker)
'    If xFiDialog.Show = -1 Then
'        xPath = xFiDialog.SelectedItems(1)
'    End If
'    Set xFiDialog = Nothing
xPath = Sayfa1.Range("G1").Text
    If xPath = "" Then Exit Sub
    Set xFSO = CreateObject("Scripting.FileSystemObject")
kontrol = xFSO.FolderExists(xPath)
If kontrol = True Then
    Set xFolder = xFSO.GetFolder(xPath)
    I = 2
    For Each xFile In xFolder.Files
        I = I + 1
        ActiveSheet.Hyperlinks.Add Cells(I, 2), xFile.Path, , , xFile.Name
    Next
Else
MsgBox "Klasör bulunamadı."
End If
End Sub

 

[KYenerSelvi]

Merhaba, klasör seçme işlemi olmadan, G1 hücresinde yazılı olan yol bilgisine göre işlem yapan kodlar.

Sub Example1()
    Dim xFSO As Object
    Dim xFolder As Object
    Dim xFile As Object
    Dim xFiDialog As FileDialog
    Dim xPath As String
    Dim I As Integer
'    Set xFiDialog = Application.FileDialog(msoFileDialogFolderPicker)
'    If xFiDialog.Show = -1 Then
'        xPath = xFiDialog.SelectedItems(1)
'    End If
'    Set xFiDialog = Nothing
xPath = Sayfa1.Range("G1").Text
    If xPath = "" Then Exit Sub
    Set xFSO = CreateObject("Scripting.FileSystemObject")
kontrol = xFSO.FolderExists(xPath)
If kontrol = True Then
    Set xFolder = xFSO.GetFolder(xPath)
    I = 2
    For Each xFile In xFolder.Files
        I = I + 1
        ActiveSheet.Hyperlinks.Add Cells(I, 2), xFile.Path, , , xFile.Name
    Next
Else
MsgBox "Klasör bulunamadı."
End If
End Sub

Aşağıdaki hatayı veriyor hocam çalışmadı. Birde A1 den itibaren aşağıya kadar köprü yaparak yapıştırıyor dosyaları bunu acaba manuel ayarlayabilirmiyiz c3 den itibaren örneğin aşağıya kadar yapıştırması için.

 

[AdemCan]

Merhaba, kullandığınız dosyada Option Explicit aktif ise kontrol değişkeni için tanımlama ister.
ActiveSheet.Hyperlinks.Add Cells(I, 3) satırında 3 değeri sütun numarasıdır, hangi sütuna yazdırmak isterseniz bu numarayı değiştirebilir ya da "C" gibi sütun harfi yazabilirsiniz.
C sütunundaki kayıtları temizlemesi için de bir satır ekledim.
G1 hücresinde yazılı olan yol bilgisine göre işlem yapar.

Sub Example1()
    Dim xFSO As Object
    Dim xFolder As Object
    Dim xFile As Object
    Dim xFiDialog As FileDialog
    Dim xPath As String
    Dim I As Integer
    Dim kontrol As Boolean
    Dim son As Long
'    Set xFiDialog = Application.FileDialog(msoFileDialogFolderPicker)
'    If xFiDialog.Show = -1 Then
'        xPath = xFiDialog.SelectedItems(1)
'    End If
'    Set xFiDialog = Nothing
son = Sheets("FF").Cells(Rows.Count, "C").End(3).Row
Sheets("FF").Range("C3:C" & son).Clear
xPath = Sheets("FF").Range("G1").Text
    If xPath = "" Then Exit Sub
    Set xFSO = CreateObject("Scripting.FileSystemObject")
kontrol = xFSO.FolderExists(xPath)
If kontrol = True Then
    Set xFolder = xFSO.GetFolder(xPath)
    I = 2
    For Each xFile In xFolder.Files
        I = I + 1
        ActiveSheet.Hyperlinks.Add Cells(I, 3), xFile.Path, , , xFile.Name
    Next
Else
MsgBox "Klasör bulunamadı."
End If
End Sub

 

[KYenerSelvi]

Süper oldu ellerine sağlık hocam

 

[AdemCan]

Rica ederim.

 

[KYenerSelvi]

Merhaba, kullandığınız dosyada Option Explicit aktif ise kontrol değişkeni için tanımlama ister.
ActiveSheet.Hyperlinks.Add Cells(I, 3) satırında 3 değeri sütun numarasıdır, hangi sütuna yazdırmak isterseniz bu numarayı değiştirebilir ya da "C" gibi sütun harfi yazabilirsiniz.
C sütunundaki kayıtları temizlemesi için de bir satır ekledim.
G1 hücresinde yazılı olan yol bilgisine göre işlem yapar.
Ekli dosyayı görüntüle 234267

Sub Example1()
    Dim xFSO As Object
    Dim xFolder As Object
    Dim xFile As Object
    Dim xFiDialog As FileDialog
    Dim xPath As String
    Dim I As Integer
    Dim kontrol As Boolean
    Dim son As Long
'    Set xFiDialog = Application.FileDialog(msoFileDialogFolderPicker)
'    If xFiDialog.Show = -1 Then
'        xPath = xFiDialog.SelectedItems(1)
'    End If
'    Set xFiDialog = Nothing
son = Sheets("Güncellemeler").Cells(Rows.Count, "A").End(1).Row
Sheets("Güncellemeler").Range("A1:A" & son).Clear
xPath = Sheets("Güncellemeler").Range("G1").Text
    If xPath = "" Then Exit Sub
    Set xFSO = CreateObject("Scripting.FileSystemObject")
kontrol = xFSO.FolderExists(xPath)
If kontrol = True Then
    Set xFolder = xFSO.GetFolder(xPath)
    I = 1
    For Each xFile In xFolder.Files
        I = I + 1
        ActiveSheet.Hyperlinks.Add Cells(I, 1), xFile.Path, , , xFile.Name
    Next
Else
MsgBox "Klasör bulunamadı."
End If
End Sub

Bu kodlar çalışıyor ama bir ilave daha rica edeceğim

Hocam bu kod ile belirli klasör deki tüm pdf leri listeliyoruz. Peki bunu ilgili klasör ve tüm alt klasörleri şeklinde değiştirebilir miyiz ?

G1 hücresi değil de ben o g1 olan yere ana klasör yolunu yazayım alt klasörlerinde de ne kadar pdf varsa hepsini listelesin hocam ? Mümkün mü

 

[KYenerSelvi]

Bu kodlar çalışıyor ama bir ilave daha rica edeceğim

Hocam bu kod ile belirli klasör deki tüm pdf leri listeliyoruz. Peki bunu ilgili klasör ve tüm alt klasörleri şeklinde değiştirebilir miyiz ?

G1 hücresi değil de ben o g1 olan yere ana klasör yolunu yazayım alt klasörlerinde de ne kadar pdf varsa hepsini listelesin hocam ? Mümkün mü

Arkadaşlar bu konu hakkında yardım bekliyorum hala.

Yardımcı olabilirseniz sevinirim

 

[Korhan Ayhan]

Merhaba,

Aşağıdaki hatırlatmam size özel değildir...

Konuyu inceleyen diğer üyelerimizinde bu konuya dikkat etmeleri başlıklarının cevapsız kalma riskini azaltacaktır.


Konu başlıklarınızda çok genel ifadeler kullanmamanızı rica ederim. Bunu şu sebeple talep ediyoruz.

Arama yapan ve aynı sıkıntıdan muzdarip olan üyeler kolaylıkla bulabilsinler diye talep ediyoruz.

Yoksa birçok üye aşağıdaki şekilde genel başlıklar kullanıyorlar; (Gözümüze çarpanları sürekli düzeltmek zorunda kalıyoruz...)

Kod revize (???)
Makro revize (???)
Makro konusunda yardım (???)
Formül konusunda yardım (???)

Özellikle aşağıdaki ifadelerin kullanılmamasını hatırlatmak isterim. Sizler konu başlığınızı uygun şekilde tercih ettiğinizde zaten forumun ana penceresinde görünüyor. Konuya ilgi duyan üyelerimizde soruları cevaplıyorlar.

Acil (???)
Destek (???)
Yardım (???)

 

[Korhan Ayhan]

Daha önce benzer sorular için hazırladığımız örnekleri inceleyiniz.

Klasör ve Dosya Listele

Arkadaşlar Bu forumda Zamanında indirdiğim bir dosyada yardıma ihtiyacım var. listelediğim klasörleri excel sayfasına aralarında boşluk olmadan aktaramıyorum, yardım için şimdiden teşekkürler. Örnek dosya ektedir Public konumSat As Integer Public konumSut As Integer Sub DosyaListeYapı()...

www.excel.web.tr

Dosya Köprüleme

Merhaba daha önce sitede bulduğum dosya köpürüleme işlemleri yapılmış excel dosyası var çok işime yarıyor ama geliştirmek için şunları istiyorum acaba olabilir mi? 1.sorum başlata tıkladıktan sonra dosya yolu sabit yapılabilir mi?(her seferinde seçmek istemiyorum 2.sorum ise başlat dosya yolu...

www.excel.web.tr

Klasördeki Dosya İsimlerini Listeleme/Değiştirme

Arşivlik kaynak olmuş, katkı sağlayan herkesin eline sağlık.

www.excel.web.tr

Kapalı Excel Dosyalarında Metin Arama ve Dosya Listeleme Programı

Değerli Arkadaşlar Merhaba Kendi çapımda Kapalı Excel Dosyalarında Metin Arama ve Dosya Listeleme Programı hazırladım. Program Sayın Korhan AYHAN Beyin bu sitede paylaştığı Dosya Listeleme programının üzerinde biraz ekleme ve çalışma yapılarak geliştirilmiştir. Programın hata ve...

www.excel.web.tr