Excel VBA List Files in Folder with Owner/Author Properties - vba

Question

This works, but is painfully slow:
Option Explicit
Sub GetDetails()
Dim oShell As Object
Dim oFile As Object
Dim oFldr As Object
Dim lRow As Long
Dim iCol As Integer
Dim vArray As Variant
vArray = Array(0, 3, 10, 20)
Set oShell = CreateObject("Shell.Application")
lRow = 1
Set oFldr = oShell.Namespace("\\mysite\www\docs\f150\group\IDL\collection\")
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)
On Error Resume Next
Cells(lRow, iCol + 1) = .getdetailsof(oFile, vArray(iCol))
Next iCol
Next oFile
End With
End Sub
I have the code below working, but I still cant get the Owner/Author or the specific file types.
Sub getFiles()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer
'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set objFolder = objFSO.GetFolder("\\mysite\www\docs\f150\group\IDL\collection")
i = 1
'loops through each file in the directory and prints their names and path
For Each objFile In objFolder.Files
'print file name
Cells(i + 1, 1) = objFile.Name
With Cells(i + 1, 1)
Cells(i + 1, 1).Select
Selection.Hyperlinks.Add Anchor:=Selection, Address:=objFile.Path
End With
'print file path
Cells(i + 1, 2) = objFile.DateLastModified
i = i + 1
Next objFile
Columns.AutoFit
End Sub
I am trying to get a list of certain files and attributes into an Excel document, but the code keeps causing Excel to crash.
The code below may have some redundancy because I've been fiddling with it all day. Ultimately I would like to get the .pptx and .pdf file names, DateLastModified, and the owner or author
Sub ListAllFile()
Application.ScreenUpdating = False
Dim objFSO As Object
Dim objFolder As Object
Dim objFolderItem As Object
Dim objFile As Object
Dim ws As Worksheet
Dim myExt1 As String
Dim myExt2 As String
myExt1 = "*.pptx"
myExt2 = "*.pdf"
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set ws = Worksheets.Add
'Get the folder object associated with the directory
Set objFolder = objFSO.GetFolder("\\mysite\www\docs\f150\group\IDL\collection")
ws.Cells(1, 1).Value = "The current files found in " & objFolder.Name & "are:"
Set objFile = objFile
'Loop through the Files collection
For Each objFile In objFolder.Files
If StrComp(objFile.Name, myExt1) = 1 Or StrComp(objFile.Name, myExt2) = 1 Then
Dim strFilePath As Object
Dim arrHeaders(35)
Dim i As Integer
Dim objShell As Object
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.Namespace("\\mysite\www\docs\f150\group\IDL\collection")
Set objFileName = objFolder.ParseName(objFile.Name)
For Each objFile In objFolder.Items
ws.Cells(ws.UsedRange.Rows.Count + 1, 1).Value = objFile.Name
ws.Cells(ws.UsedRange.Rows.Count + 0, 2).Value = objFile.DateLastModified
'This returns the "Owner" as the value for every file (not what I want)
ws.Cells(ws.UsedRange.Rows.Count + 0, 3).Value = objFolder.GetDetailsOf(objFile, 10)
'This returns the "Author" as the value for every file (not what I want)
ws.Cells(ws.UsedRange.Rows.Count + 0, 4).Value = objFolder.GetDetailsOf(objFile, 20)
'This returns the actual owner
ws.Cells(ws.UsedRange.Rows.Count + 0, 5).Value = objFolder.GetDetailsOf(strFileName, 10)
'This returns the actual author
ws.Cells(ws.UsedRange.Rows.Count + 0, 6).Value = objFolder.GetDetailsOf(strFileName, 20)
Next
End If
Next
Columns.AutoFit
'Clean up
Set objFolder = Nothing
Set objFile = Nothing
Set objFSO = Nothing
Set objShell = Nothing
Set objFileName = Nothing
Set ws = Nothing
Application.ScreenUpdating = True
End Sub

Answer 1

I changed the second for each loop variable name to objfile1 and made appropriate modifications below it:
For Each objfile1 In objFolder.Items
ws.Cells(ws.UsedRange.Rows.Count + 1, 1).Value = objfile1.Name
ws.Cells(ws.UsedRange.Rows.Count + 0, 2).Value = objFile.DateLastModified
Note that DateLastModified is a property of objFile while Name belongs to objfile1.
Hope this helps.

Answer 2

You could try and use the CMD.exe DIR command to optimize it a bit, as well as a couple of other tweaks:
Sub Foo()
Dim myExt1 As String
Dim myExt2 As String
Dim searchFolder As Variant
Dim finalArray As Object
Dim shellObj As Object
searchFolder = "\\mysite\www\docs\f150\group\IDL\collection"
myExt1 = "*.pptx"
myExt2 = "*.pdf"
Set finalArray = CreateObject("System.Collections.ArrayList")
Set shellObj = CreateObject("Shell.Application").Namespace(searchFolder)
For Each file In Filter(Split(CreateObject("WScript.Shell").Exec("CMD /C DIR " & searchFolder & "\" & myExt1 & " /B /A:-D").StdOut.ReadAll, vbCrLf), ".")
finalArray.Add CStr(file)
Next
For Each file In Filter(Split(CreateObject("WScript.Shell").Exec("CMD /C DIR " & searchFolder & "\" & myExt2 & " /B /A:-D").StdOut.ReadAll, vbCrLf), ".")
finalArray.Add CStr(file)
Next
For Each file In finalArray.ToArray()
With Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
.Value = CStr(file)
.Offset(0, 1).Value = shellObj.GetDetailsOf(CStr(file), 10)
.Offset(0, 2).Value = shellObj.GetDetailsOf(CStr(file), 20)
End With
Next
End Sub