ses dsyalarının bazı ozelliklerini yeniden yazdırma

[cellswhite]

Arkadaslar merhaba,

Bir konuda destek verebilirseniz çok sevineceğim.

Bilgisayarımın C sürücsünde ornek : "c:\sesler\HakanAltun\seninicin.mp3" şarkısının ( bir dongu ile )

Author
Title
Artist
Album Title ozelliklerini kendim yazdırmak istiyorum ornek "Sarkı1" gibi.

Nasıl bir VBA kodu ile yapabiliriz.

Destek verebilirmisiniz.

 

[halit3]

Aşağıdaki linke bir bak istersen

http://www.excel.web.tr/f48/dosya-ozellikleri-listeleme-t89414.html

 

[cellswhite]

Halit Bey,

Dosya ozelliklerini listeliyor güzel bir çalışma elinize sağlık.Belki sorumun cevabı içindedir ama ben göremedim.

örnek: "c:\sesler\HakanAltun\seninicin.mp3" bu dosyanın title ,artist ve album title seçeneklerini modifiye etmem gerekecek.
Daha basit bir kod ile bana yardımcı olabilirmisiniz.

İyi çalışmalar.

 

[halit3]

Halit Bey,

Dosya ozelliklerini listeliyor güzel bir çalışma elinize sağlık.Belki sorumun cevabı içindedir ama ben göremedim.

örnek: "c:\sesler\HakanAltun\seninicin.mp3" bu dosyanın title ,artist ve album title seçeneklerini modifiye etmem gerekecek.
Daha basit bir kod ile bana yardımcı olabilirmisiniz.

İyi çalışmalar.

Bu dosya müzik dosyalarına ait özelliklerinde görünenleri listeliyor

Dim Klasor As Object
Dim Kaynak As String
Dim sat
Sub dosyaListele5()
sat = 2
Set Klasor = CreateObject("shell.application").BrowseForFolder(0, "Kaynak Dosyaları İçeren Klasörü Seçin", 50, &H0)
If Not Klasor Is Nothing Then
Kaynak = Klasor.SELF.Path
If InStr(1, Kaynak, "{") > 0 Then GoTo Atla
Cells.ClearContents
Cells(1, 1) = "Dosya adı"
For a = 1 To 48
Cells(1, a + 1) = CreateObject("Shell.Application").Namespace(Klasor).GetDetailsOf("", a)
Next
For Each Dosya In CreateObject("Scripting.FileSystemObject").GetFolder(Kaynak).Files
Cells(sat, 1) = Dosya
Set Dosya1 = CreateObject("Shell.Application").Namespace(Kaynak & "\").ParseName(Dosya.Name)
For a = 1 To 48
Cells(sat, a + 1) = CreateObject("Shell.Application").Namespace(Kaynak & "\").GetDetailsOf(Dosya1, a)
Next
sat = sat + 1
Next
MsgBox "işlem tamam !", vbInformation, "DİKKAT"
Else
Atla:
MsgBox "Lütfen Kaynak Klasör Seçimini Yapınız !", vbInformation, "DİKKAT"
End If
Set Obj = Nothing
Set Klasor = Nothing
End Sub

 

[cellswhite]

Halit Bey,

Evet dediğiniz gibi listeleme işi ok.Bende bunlar içerisinde 10,11 ince ( title , Album Title ) bilgilerini istedğim şekilde modifiye etmek istiyorum mümkünmüdür.

 

[halit3]

Halit Bey,

Evet dediğiniz gibi listeleme işi ok.Bende bunlar içerisinde 10,11 ince ( title , Album Title ) bilgilerini istedğim şekilde modifiye etmek istiyorum mümkünmüdür.

Kod 10 ve 11. leri listeliyor

Dim Klasor As Object
Dim Kaynak As String
Dim sat
Sub dosyaListele5()
sat = 2
Set Klasor = CreateObject("shell.application").BrowseForFolder(0, "Kaynak Dosyaları İçeren Klasörü Seçin", 50, &H0)
If Not Klasor Is Nothing Then
Kaynak = Klasor.SELF.Path
If InStr(1, Kaynak, "{") > 0 Then GoTo Atla
Cells.ClearContents
Cells(1, 1) = "Dosya adı"
Cells(1, 2) = CreateObject("Shell.Application").Namespace(Klasor).GetDetailsOf("", 10)
Cells(1, 3) = CreateObject("Shell.Application").Namespace(Klasor).GetDetailsOf("", 11)
For Each Dosya In CreateObject("Scripting.FileSystemObject").GetFolder(Kaynak).Files
Cells(sat, 1) = Dosya
Set Dosya1 = CreateObject("Shell.Application").Namespace(Kaynak & "\").ParseName(Dosya.Name)
Cells(sat, 2) = CreateObject("Shell.Application").Namespace(Kaynak & "\").GetDetailsOf(Dosya1, 10)
Cells(sat, 3) = CreateObject("Shell.Application").Namespace(Kaynak & "\").GetDetailsOf(Dosya1, 11)
sat = sat + 1
Next
MsgBox "işlem tamam !", vbInformation, "DİKKAT"
Else
Atla:
MsgBox "Lütfen Kaynak Klasör Seçimini Yapınız !", vbInformation, "DİKKAT"
End If
Set Obj = Nothing
Set Klasor = Nothing
End Sub

 

[cellswhite]

Halit Bey,
Yanlıls olduguna eminim ama aşağıdaki gibi bir değişiklik mantıklımıdır:Şarkının title değiştirmek


CreateObject("Shell.Application").Namespace(Kaynak & "\").GetDetailsOf(Dosya1, 10).Title.Text = "Deneme1"

 

[cellswhite]

Halit Bey,

Çözüm öneriniz varmıdır?

 

[Zeki Gürsoy]

Bu özellikler "read-only" dir. Yani değer atayamaz, sadece okuyabilirsiniz...

 

[halit3]

Halit Bey,

Çözüm öneriniz varmıdır?

Bende araştırıyordum bu durumu Zeki Bey cevap vermiş teşekkürler.

 

[cellswhite]

Teşekkurler arkadaşlar iyi çalışmalar.