Döküman Adını Excell Hücresine Otomatik Getirme

[Said ERSOY]

Merhaba Arkadaşlar;

Benim bir adet klasörüm var bu klasör içerisinde farklı isimlerde pdf dökümanları var (a,b,c gibi) Bu dökümanların isimlerini oluşturduğum excellde istediğim hücrelere sırasıyla getirmek istiyorum. Örnek a dökümanının ismini ve mümkünse linkini A1 hücresine b dökümanının ismini ve linkini B1 hücresine gibi. Burada sıkıntım şu ki a dökümanı a1 olarak revize olduğunda A1 hücresine en güncel olanı gelmeli eskisi gelmemeli. Makro konusunda acemi olduğum için internetten kaynak olarak bulduğum kodlarım aşağıdadır.Bu kodla yapınca klasör içerisindeki tüm dökümanların isimlerini ve linklerini getiriyor. Nasıl yapabilirim yardımcı olabilirmisiniz.

Şimdiden herkese çok teşekkürler

Sub Klasor_Indexle()

On Error Resume Next
Dim stDir As String
Dim stFile As String
Dim R As Range

Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer
Dim fldr As FileDialog
Dim klasor_adi As String
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
fldr.Show
klasor_adi = fldr.SelectedItems.Item(1)
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set objFolder = objFSO.GetFolder(klasor_adi)



' puts hyperlinks to each of the files in a directory of your choice
' into the active sheet starting at the active cell

Set R = ActiveCell
stDir = klasor_adi
stFile = Dir(stDir & "\*.*")
Do Until stFile = ""
R.Hyperlinks.Add R, stDir & "\" & stFile, , , stFile
Set R = R.Offset(1)
stFile = Dir()
Loop
R.CurrentRegion.Sort key1:=R, order1:=xlAscending, Header:=xlNo
Selection.EntireColumn.AutoFit
End Sub

 

[ÖmerBey]

Aşağıdaki şekilde deneyiniz...

Sub Klasor_Indexle()

On Error Resume Next
Dim stDir As String
Dim stFile As String
Dim R As Range
Dim degis As Double, olus As Double
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer
Dim fldr As FileDialog
Dim klasor_adi As String
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
fldr.Show
klasor_adi = fldr.SelectedItems.Item(1)
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set objFolder = objFSO.GetFolder(klasor_adi)



' puts hyperlinks to each of the files in a directory of your choice
' into the active sheet starting at the active cell

Set R = ActiveCell
stDir = klasor_adi
stFile = Dir(stDir & "\*.*")
Do Until stFile = ""
    R.Hyperlinks.Add R, stDir & "\" & stFile, , , stFile
    degis = CDbl(objFSO.GetFile(stDir & "\" & stFile).DateLastModified)
    olus = CDbl(objFSO.GetFile(stDir & "\" & stFile).DateCreated)
    R.Offset(0, 1) = Application.Max(degis, olus)
    degis = 0
    olus = 0
    Set R = R.Offset(1)
    stFile = Dir()
Loop
R.CurrentRegion.Sort key1:=R.Offset(0, 1), order1:=xlDescending, Header:=xlNo
R.CurrentRegion.Columns(2).ClearContents
Selection.EntireColumn.AutoFit
End Sub

 

[Said ERSOY]

Merhaba Ömer Bey;

Öncelikle ilginiz için teşekkür ederim. Paylaştığınız kodları denediğimde istediğimden ufak farklar olduğunu gördüm.Şöyleki
1- Hala kodlar klasör içerisindeki tüm dökümanların adını ve linkini getirmektedir. Biz sadece en güncel olan pdf dökümanın gelmesini istiyoruz. pdf formatında olan dökümanlardan en güncel olanı
2- Yan satıra tarih gelmesine gerek yok tarih bizim için gerekli değil

klasör içerisinden çektireceğimiz en güncel pdf formatlı dökümanları istediğimizi hücreye yazdıracağız. Burda sadece pdf olanların ismi gelmeli başka uzantılı dosya isimleri gelmemeli (örneğin dwg. stp. gibi uzantılı dosyalar) ve en güncel olanı gelmelidir.

 

[ÖmerBey]

pdf dökümanın gelmesini istiyoruz

Kod içindeki stFile = Dir(stDir & "\*.*") satırını stFile = Dir(stDir & "\*.pdf") olarak değiştiriniz.

Yan satıra tarih gelmesine gerek yok tarih bizim için gerekli değil

Tarih, güncellik sıralaması için kullanılıyor, yani tarih yan sütuna yazdırılıp ona göre sıralama yapılıyor. En güncel dosyanın alınabilmesi için ve kodun sonunda sıralama sonrası tarih siliniyor. Bu sıralama değişken ile de yapılabilir ama ben kodunuzun yapısına müdahale etmek istemediğim için bu şekilde oldu...

 

[Said ERSOY]

Merhaba Ömer Bey;

İlginiz için çok teşekkür ederim. pdf olayı çözüldü ama satıra sadece en güncel olan 1 adet pdf gelmesi gerekiyor şuanki durumda klasör içerisinde yer alan tüm pdf dökümanlarını getiriyor. Bize sadece en güncel olan 1 tane pdf gerekli birde " koda istediğiniz gibi müdahele edebilirsiniz sorun yok " yan satırda da aynı makroyu tekrar kullanıyorum bu nedenle oraya tarih gelmesi 2.kez kullanımımı bozuyor yani değişken ile yapabiliriz diye düşünüyorum. Teşekkürler

 

[Said ERSOY]

Merhaba;

Kodları aşağıdaki gibi düzenlediğimde istediğim güncel olan dökümanı ve sadece pdf formatlı olanları getirdi. Farklı bir soru daha sormak istiyorum. Oluşturduğumuz bu makro ile veri segmesi kullanılarak veya başka yöntemlerle güncel tutabilirmiyim yani excel sayfasını her açtığımda "tümünü yenile " gibi bir yöntemle sayfayı güncel tutabilirmiyim? Teşekkürler

Sub Klasor_Indexle()

On Error Resume Next
Dim stDir As String
Dim stFile As String
Dim R As Range
Dim degis As Double, olus As Double
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer
Dim fldr As FileDialog
Dim klasor_adi As String
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
fldr.Show
klasor_adi = fldr.SelectedItems.Item(1)
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set objFolder = objFSO.GetFolder(klasor_adi)



' puts hyperlinks to each of the files in a directory of your choice
' into the active sheet starting at the active cell

Set R = ActiveCell
stDir = klasor_adi
stFile = Dir(stDir & "\*.pdf")
Do Until stFile = ""
R.Hyperlinks.Add R, stDir & "\" & stFile, , , stFile
degis = CDbl(objFSO.GetFile(stDir & "\" & stFile))
olus = CDbl(objFSO.GetFile(stDir & "\" & stFile))
R.Offset(0, 1) = Application.Max(degis, olus)
degis = 0
olus = 0
Set R = R.Offset(0)
stFile = Dir()
Loop
R.CurrentRegion.Sort key1:=R.Offset(0, 1), order1:=xlDescending, Header:=xlNo
R.CurrentRegion.Columns(2).ClearContents
Selection.EntireColumn.AutoFit
End Sub

 

[ÖmerBey]

Aşağıdaki kodu deneyiniz...

Sub Klasor_Indexle()

On Error Resume Next
Dim stDir As String
Dim stFile As String
Dim R As Range
Dim degis As Double, olus As Double
Dim tarih As Double
Dim dosya As String, link As String
Dim objFSO As Object
Dim fldr As FileDialog
Dim klasor_adi As String
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
fldr.Show
klasor_adi = fldr.SelectedItems.Item(1)
Set objFSO = CreateObject("Scripting.FileSystemObject")

Set R = ActiveCell
stDir = klasor_adi
stFile = Dir(stDir & "\*.pdf")
Do Until stFile = ""
    degis = CDbl(objFSO.GetFile(stDir & "\" & stFile).DateLastModified)
    olus = CDbl(objFSO.GetFile(stDir & "\" & stFile).DateCreated)
    If Application.Max(degis, olus) > tarih Then
        tarih = Application.Max(degis, olus)
        dosya = stFile
        link = stDir & "\" & stFile
    End If
    degis = 0
    olus = 0
    stFile = Dir()
Loop
R.Hyperlinks.Add R, link, , , dosya
End Sub

Yukarıdaki kod ile klasörü seçtirerek dosyaları kontrol ettiriyorsunuz. Manuel seçim yerine dosyanıza klasör yolunu yazıp kod içinde kullandırılarak her zaman otomatik güncelleme sağlanabilir. Buna uygun kod için dosya yapınızın bilinmesi gerekiyor.

 

[arslan47]

Merhaba Arkadaşlar;

Benim bir adet klasörüm var bu klasör içerisinde farklı isimlerde pdf dökümanları var (a,b,c gibi) Bu dökümanların isimlerini oluşturduğum excellde istediğim hücrelere sırasıyla getirmek istiyorum. Örnek a dökümanının ismini ve mümkünse linkini A1 hücresine b dökümanının ismini ve linkini B1 hücresine gibi. Burada sıkıntım şu ki a dökümanı a1 olarak revize olduğunda A1 hücresine en güncel olanı gelmeli eskisi gelmemeli. Makro konusunda acemi olduğum için internetten kaynak olarak bulduğum kodlarım aşağıdadır.Bu kodla yapınca klasör içerisindeki tüm dökümanların isimlerini ve linklerini getiriyor. Nasıl yapabilirim yardımcı olabilirmisiniz.

Şimdiden herkese çok teşekkürler

Sub Klasor_Indexle()

On Error Resume Next
Dim stDir As String
Dim stFile As String
Dim R As Range

Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer
Dim fldr As FileDialog
Dim klasor_adi As String
Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
fldr.Show
klasor_adi = fldr.SelectedItems.Item(1)
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set objFolder = objFSO.GetFolder(klasor_adi)



' puts hyperlinks to each of the files in a directory of your choice
' into the active sheet starting at the active cell

Set R = ActiveCell
stDir = klasor_adi
stFile = Dir(stDir & "\*.*")
Do Until stFile = ""
R.Hyperlinks.Add R, stDir & "\" & stFile, , , stFile
Set R = R.Offset(1)
stFile = Dir()
Loop
R.CurrentRegion.Sort key1:=R, order1:=xlAscending, Header:=xlNo
Selection.EntireColumn.AutoFit
End Sub

Merhabalar,
Bu kodu olduğu gibi kullanıyorum ve çok memnunum. Gayet başarılı ellerinize sağlık. Yalnız benim ayrıca istediğim. Bu işlemi yaparken ayrıca klasör içindeki yalnızca dosyaları değil de klasör içindeki alt klasörleri listelemesi ve bunlara köprü eklemesi. Yani dosyalara köprü eklemesi yerine alt klasöre köprü eklemesi ve tıkladığım zaman direk olarak tıklamış olduğum klasörün içerisine girmek.