VBA FileSystemObject Properties: Dimensions, Size and Vertical resolution

[ferguson]

I have a VBA script that lists the file names and some of the file properties contained in a folder. I'd like to retrieve file properties of Dimensions and Vertical resolution as well. Are these properties available via FileSystemObject Properties? Or is there another way to pull this metadata? My script is below.

Cheers!

Sub TestListFilesInFolder()
'Workbooks.Add ' create a new workbook for the file list
' add headers
Dim Folder As String, InputFolder As String
MsgBox ("Please locate and select the folder containing the vendor's files.")
Folder = Application.GetOpenFilename("Folder, *")
InputFolder = getFilePath(Folder)
With Range("A1")
.Formula = "Folder contents:"
.Font.Bold = True
.Font.Size = 12
End With
Range("A3").Formula = "File Name:"
Range("B3").Formula = "File Size:"
Range("C3").Formula = "File Type:"
Range("D3").Formula = "Date Created:"
Range("E3").Formula = "Date Last Accessed:"
Range("F3").Formula = "Date Last Modified:"
Range("G3").Formula = "Attributes:"
Range("H3").Formula = "Short File Name:"
Range("A3:H3").Font.Bold = True
ListFilesInFolder InputFolder, True
' list all files included subfolders
End Sub

Sub ListFilesInFolder(SourceFolderName As String, IncludeSubfolders As Boolean)
' lists information about the files in SourceFolder
' example: ListFilesInFolder "C:\FolderName\", True
Dim FSO As Scripting.FileSystemObject
Dim SourceFolder As Scripting.Folder, SubFolder As Scripting.Folder
Dim FileItem As Scripting.File
Dim r As Long
Set FSO = New Scripting.FileSystemObject
Set SourceFolder = FSO.GetFolder(SourceFolderName)
r = Range("A65536").End(xlUp).Row + 1
For Each FileItem In SourceFolder.Files
' display file properties
Cells(r, 1).Formula = FileItem.Name
Cells(r, 2).Formula = FileItem.Size
Cells(r, 3).Formula = FileItem.Type
Cells(r, 4).Formula = FileItem.DateCreated
Cells(r, 5).Formula = FileItem.DateLastAccessed
Cells(r, 6).Formula = FileItem.DateLastModified
Cells(r, 7).Formula = FileItem.Attributes
Cells(r, 8).Formula = FileItem.ShortPath
' use file methods (not proper in this example)
' FileItem.Copy "C:\FolderName\Filename.txt", True
' FileItem.Move "C:\FolderName\Filename.txt"
' FileItem.Delete True
r = r + 1 ' next row number
Next FileItem
If IncludeSubfolders Then
For Each SubFolder In SourceFolder.SubFolders
ListFilesInFolder SubFolder.path, True
Next SubFolder
End If
Columns("A:H").AutoFit
Set FileItem = Nothing
Set SourceFolder = Nothing
Set FSO = Nothing
ActiveWorkbook.Saved = True
End Sub
Function getFilePath(path As String)

Dim filePath() As String
Dim finalString As String
Dim x As Integer
filePath = Split(path, "\")

For x = 0 To UBound(filePath) - 1
finalString = finalString & filePath(x) & "\"
Next

getFilePath = finalString
End Function

[ragulduy]

Please take a moment to read the forum rules, use code tags and post links to cross-posts on other forums.

Also, are you talking about images here? you want to know the size and resolution of a bunch of images? Maybe have a look here:
http://www.excelforum.com/excel-prog...excel-vba.html