B58 deki değerle dosyanın açıklamalar bölümüne kaydettirme ve o dosyaları çağırma?

[seyehat25]

merhabalar...
arkadaşlar farklı kaydet deyince b58 hücresindeki değeri dosya adı olrak istediğim dizine kaydettirmeyi başardım acaba bunun yanında dosyamızın sağtıklayıp özet kısmındaki açıklamalar(comments) kısmınada b58 deki değeri kaydettirebilir miyim?
çünkü bu dosyaları dosya adları ile excele çağırtıp sutunlara ayırtıp süz yapıyorum.şimdi ise açıklamalara kaydettirip bu sefer açıklamar kısmını excele çağırabilir miyiz?
farklı dizine kaydettirdiğim kod:
__________________________________________________ ____________
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs "\\Server01\ortak\TALEPFORM\" & [talep!b58]
End Sub
************************************************** **
kaydettirdiğim dosyaları isimleri ile excele çağırdığım kod:
__________________________________________________ ______________
Private Sub CommandButton1_Click()
Dim Klasor As String
Dim Dosya As String
Dim i As Integer
Klasor = "\\Server01\ortak\TALEPFORM\Arşiv\"
Dosya = Dir(Klasor & Application.PathSeparator & "*.xls", vbDirectory)
Do While Dosya <> ""
Cells(i + 1, 1) = Dosya
i = i + 1
Dosya = Dir
Loop
************************************************** *****
madem dosya adı ile kaydettirdin excelede çağırıp süz yaptırabiliyorsun ne diye daha kurcalıyorsun derseniz;b58 hücrem birleştirilmiş bir değer ve içindeki değer değişiyo ve dosya ismi olduğundan kaydet deyince bu sefer bambaşka birr dosya olarak kaydediyor!
açıklamalar kaydettiğim de bunları bu sefer nasıl çağıracağım onuda yazarsanız çok sevinirim.

 

[Ferhat Pazarçevirdi]

Merhabalar

Aşağıdaki şekilde kodunuzu değiştiriniz.

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Application.DisplayAlerts = False
With ActiveWorkbook
     [COLOR=red].BuiltinDocumentProperties("Comments") = Range("B58")
[/COLOR]     .SaveAs "[URL="file://server01/ortak/TALEPFORM/"]\\Server01\ortak\TALEPFORM\[/URL]" & [talep!b58]
End With
End Sub

 

[seyehat25]

öncelikle ilginiz için çok çok teşekkür edioyrum...
verdiğiniz kodu şeklinde değiştirdim ama açılamalar kısmının karekter kısıtlaması işimi bozdu ben o kısıma daha uzun metin kaydetmeyi planlıyordum!
peki şimdi excele dosyaları listeletiyorum ya dosya adı yerine açıklamalar kısmını listeletmek nasıl olacak?
kaydettirdiğim dosyaları isimleri ile excele çağırdığım kod:
__________________________________________________ ______________
Private Sub CommandButton1_Click()
Dim Klasor As String
Dim Dosya As String
Dim i As Integer
Klasor = "\\Server01\ortak\TALEPFORM\Arşiv\"
Dosya = Dir(Klasor & Application.PathSeparator & "*.xls", vbDirectory)
Do While Dosya <> ""
Cells(i + 1, 1) = Dosya
i = i + 1
Dosya = Dir
Loop

 

[Ferhat Pazarçevirdi]

O zaman, aşağıdaki kodu kullanın

Dim Klasor As String
Dim i As Integer
Klasor = "[URL="file://server01/ortak/TALEPFORM/Arşiv/"]\\Server01\ortak\TALEPFORM\Arşiv\[/URL]"
With Application.FileSearch
     .FileType = msoFileTypeExcelWorkbooks
     .LookIn = Klasor
     If .Execute > 0 Then
        For i = 1 To .FoundFiles.Count
            Cells(i + 1, 1) = .FoundFiles(i).BuiltinDocumentProperties("Comments")
        Next i
     End If
End With