Çözüldü Fotoğraf bilgisi ekleme

[Ferhatgök]

.jpg uzantılı fotoğrafları excele eklediğimde .jpg uzantılı dosyamın sağ tıklandığı çıkan özellikler bilgisini de excel çalışma sayfama eklemek istiyorum. Ancak çözemedim yardımcı olur musunuz?

 

[muhasebeciyiz]

Sub DosyaOzellikleriniGetir()
Dim dosyaAdi As String
Dim ozellikler As String

dosyaAdi = Range("A1").Value

If dosyaAdi <> "" Then
ozellikler = DosyaOzellikleriAl(dosyaAdi)

Range("B1").Value = ozellikler
Else
MsgBox "Dosya adı bulunamadı!", vbExclamation
End If
End Sub

Function DosyaOzellikleriAl(dosyaAdi As String) As String
Dim objFSO As Object
Dim objDosya As Object
Dim ozellikler As String

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objDosya = objFSO.GetFile(dosyaAdi)
ozellikler = "Dosya Adı: " & objDosya.Name & vbCrLf & _
"Boyut: " & objDosya.Size & " byte" & vbCrLf & _
"Oluşturulma Tarihi: " & objDosya.DateCreated & vbCrLf & _
"Değiştirilme Tarihi: " & objDosya.DateLastModified & vbCrLf & _
"Erişim Tarihi: " & objDosya.DateLastAccessed
Set objDosya = Nothing
Set objFSO = Nothing

DosyaOzellikleriAl = ozellikler
End Function


Yukardaki kod A1 hücresindeki dosya adını alır ve bu dosyanın adı, boyutu, oluşturulma tarihi, değiştirilme tarihi ve
erişim tarihini içeren bir dizeyi B1 hücresine eklemektedir.

 

[Ferhatgök]

Sub DosyaOzellikleriniGetir()
Dim dosyaAdi As String
Dim ozellikler As String

dosyaAdi = Range("A1").Value

If dosyaAdi <> "" Then
ozellikler = DosyaOzellikleriAl(dosyaAdi)

Range("B1").Value = ozellikler
Else
MsgBox "Dosya adı bulunamadı!", vbExclamation
End If
End Sub

Function DosyaOzellikleriAl(dosyaAdi As String) As String
Dim objFSO As Object
Dim objDosya As Object
Dim ozellikler As String

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objDosya = objFSO.GetFile(dosyaAdi)
ozellikler = "Dosya Adı: " & objDosya.Name & vbCrLf & _
"Boyut: " & objDosya.Size & " byte" & vbCrLf & _
"Oluşturulma Tarihi: " & objDosya.DateCreated & vbCrLf & _
"Değiştirilme Tarihi: " & objDosya.DateLastModified & vbCrLf & _
"Erişim Tarihi: " & objDosya.DateLastAccessed
Set objDosya = Nothing
Set objFSO = Nothing

DosyaOzellikleriAl = ozellikler
End Function


Yukardaki kod A1 hücresindeki dosya adını alır ve bu dosyanın adı, boyutu, oluşturulma tarihi, değiştirilme tarihi ve
erişim tarihini içeren bir dizeyi B1 hücresine eklemektedir.

Teşekkür ederim bakınca çalışacak gibi duruyor. Eve gider gitmez ilk bunu deneyeceğim.