- Katılım
- 7 Mayıs 2006
- Mesajlar
- 363
- Excel Vers. ve Dili
- 2019 İngilizce
- Altın Üyelik Bitiş Tarihi
- 04.12.2019
Arkadaşlar merhaba,
d:\2016 Resim Arşivi\ klasörünün içinde alt klasörler var ve bunların içinde toplam 30-35bin adet resim var. Bu resimlerin bazı özelliklerini excelde macro ile listelemek istiyorum. İstediğim özellikler:
Dosya Yolu - Dosya Adı - Genişlik, Uzunluk - Dosya Boyutu (byte cinsinden)
2 gündür araştırıyorum, bir kaç kod buldum fakat istediğim sonucu alamadım. En kullanışlı olan kodu ekliyorum. Üzerinde belki iyileştirme yapılabilir. Bu kodda klasör seçmek yerine verdiğim yoldaki tüm klasörleri kendi bulup listelemeyi yapsın, ben uğraşmayayım. Teşekkür ederim, saygılar...
Sub RSM()
Dim oShell As Object
Dim oFile As Object
Dim oFldr As Object
Dim oFolder As Object
Dim lRow As Long
Dim iCol As Integer
Dim vArray As Variant
Dim SY As Worksheet
vArray = Array(0, 31, 1, 163)
'0=Name, 31=Dimensions, 1=Size, 163=Vertical Resolution
Set SY = Sheets("YARDIMCI")
Set oShell = CreateObject("Shell.Application")
lRow = 1
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Select the Folder..."
If .Show Then
Set oFldr = oShell.Namespace(.SelectedItems(1))
With oFldr
For iCol = LBound(vArray) To UBound(vArray)
Cells(lRow, iCol + 1) = .getdetailsof(.items, vArray(iCol))
Next iCol
For Each oFile In .items
lRow = lRow + 1
For iCol = LBound(vArray) To UBound(vArray)
Cells(lRow, iCol + 1) = .getdetailsof(oFile, vArray(iCol))
Next iCol
Next oFile
End With
End If
End With
End Sub
d:\2016 Resim Arşivi\ klasörünün içinde alt klasörler var ve bunların içinde toplam 30-35bin adet resim var. Bu resimlerin bazı özelliklerini excelde macro ile listelemek istiyorum. İstediğim özellikler:
Dosya Yolu - Dosya Adı - Genişlik, Uzunluk - Dosya Boyutu (byte cinsinden)
2 gündür araştırıyorum, bir kaç kod buldum fakat istediğim sonucu alamadım. En kullanışlı olan kodu ekliyorum. Üzerinde belki iyileştirme yapılabilir. Bu kodda klasör seçmek yerine verdiğim yoldaki tüm klasörleri kendi bulup listelemeyi yapsın, ben uğraşmayayım. Teşekkür ederim, saygılar...
Sub RSM()
Dim oShell As Object
Dim oFile As Object
Dim oFldr As Object
Dim oFolder As Object
Dim lRow As Long
Dim iCol As Integer
Dim vArray As Variant
Dim SY As Worksheet
vArray = Array(0, 31, 1, 163)
'0=Name, 31=Dimensions, 1=Size, 163=Vertical Resolution
Set SY = Sheets("YARDIMCI")
Set oShell = CreateObject("Shell.Application")
lRow = 1
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Select the Folder..."
If .Show Then
Set oFldr = oShell.Namespace(.SelectedItems(1))
With oFldr
For iCol = LBound(vArray) To UBound(vArray)
Cells(lRow, iCol + 1) = .getdetailsof(.items, vArray(iCol))
Next iCol
For Each oFile In .items
lRow = lRow + 1
For iCol = LBound(vArray) To UBound(vArray)
Cells(lRow, iCol + 1) = .getdetailsof(oFile, vArray(iCol))
Next iCol
Next oFile
End With
End If
End With
End Sub
