Çoklu Dosya İsimlendirme -Önemli-

[3641]

Arkadaşlar hardisk çöktü,
Bilgisayarcıya gittim Harddiski kurtardı kurtarmasına ama Yaklaşık 2007 den beri olan çalışmaların tümü ( Yaklaşık 12.000 Excel dosyası ) dosya isimleri "FILE0001" diye klasörler içinde kurtardı.

Ya tüm dosyaları tek tek açarak içindeki nedir diye dosya adı vericem
Ya da yardımlarınızla bu badireyi atlatacam.

Sizlerdem ricam mümkünse Dosya Sağ tuş menüsü ile açılan "Özelliler" penceresi içerisinde Genel - "Ayrıntılar" Sekmesi içinde bulunan

Yazan ----------------
En Son Kaydeden -----
Değişiklik Sayısı -------
Uygulama Adı ---------
Şirket ----------------
Oluşturma Tarihi ------
Son Kaydetme Tarihi ---
Son Yazdırma ----------


bilgilerini dosya adı ile birlikte makro ile aldırmak mümkünmüdür.
Mümkünse şayet bu çalışmayla benim işimi çok kolaylaştıracaksınız.

Şimdiden teşekkür ederim.

Saygılarımla,

 

[Levent Menteşoğlu]

Aşağıdaki kodu boş bir excel dosyasında denermisiniz.

Sub dosyaozellikleri()
On Error Resume Next
Set klasor = CreateObject("Shell.Application").BrowseForFolder(0, "Lütfen bir klasör seçin !", &H100)
klasoryolu = klasor.Items.Item.Path
If klasoryolu = "" Then Exit Sub
For Each dosyaadi In CreateObject("Scripting.FileSystemObject").GetFolder(klasoryolu).Files
c = c + 1
Set dosya = CreateObject("Shell.Application").Namespace(klasor).ParseName(dosyaadi.Name)
Cells(1, c + 1) = dosyaadi.Name
For a = 1 To 40
If c = 1 Then Cells(a + 1, "a") = CreateObject("Shell.Application").Namespace(klasor).GetDetailsOf("", a)
Cells(a + 1, c + 1) = CreateObject("Shell.Application").Namespace(klasor).GetDetailsOf(dosya, a)
Next
Next
End Sub

 

[3641]

Levent Menteşoğlu BÜYÜKSÜN

İlgin alakan ve yardımın için ne kadar teşekkür etsem azdır.

Tekrar ve Tekrar BÜYÜKSÜN

 

[Levent Menteşoğlu]

Rica ederim. Sorununuza yardımcı olabildiğime sevindim.

 

[Selçuk1]

hocam gerçekten süpersiniz.. excelde yapılabileceklerin hayal gücüyle sınırlı olduğunu bir daha gördük sayenizde.. hızlı ve pratik çözümler süper.. ilginize ve bilginize hayran olmamak elde değil.. bize bu müthiş dünyanın sınırlarını zorlamayı öğrettiğiniz için teşekkürler ve tebrikler..