I got the following VBA script the other day, but still had no way to retrieve the file author with the line I highlighted in bold font type. Is there someone would like to check it out and make necessary modification for me. I would appreciate it.
Sub ListFiles()
iRow = 11
Call ListMyFiles(Range("C7"), Range("C8"))
End Sub
Sub ListMyFiles(mySourcePath, IncludeSubfolders)
Set MyObject = New Scripting.FileSystemObject
Set mySource = MyObject.GetFolder(mySourcePath)
On Error Resume Next
For Each myFile In mySource.Files
iCol = 2
Cells(iRow, iCol).Value = myFile.Path
iCol = iCol + 1
Cells(iRow, iCol).Value = myFile.Name
iCol = iCol + 1
Cells(iRow, iCol).Value = myFile.Size
iCol = iCol + 1
Cells(iRow, iCol).Value = myFile.Owner
iRow = iRow + 1
Next
If IncludeSubfolders Then
For Each mySubFolder In mySource.SubFolders
Call ListMyFiles(mySubFolder.Path, True)
Next
End If
End Sub
The Author is not in the list of Attributes, you have to use a different method for that:
Dim ShellObject As Object, MyObject As Object, MySource As Object, MyFile As Object, DirObject As Object, iCol As Byte, iRow As Long
Set ShellObject = CreateObject("Shell.Application")
Set DirObject = ShellObject.Namespace(mySourcePath)
Set MyObject = CreateObject("Scripting.FileSystemObject")
Set MySource = MyObject.GetFolder(mySourcePath)
On Error Resume Next
For Each MyFile In MySource.Files
iCol = 2
Cells(iRow, iCol).Value = MyFile.Path
iCol = iCol + 1
Cells(iRow, iCol).Value = MyFile.Name
iCol = iCol + 1
Cells(iRow, iCol).Value = MyFile.Size
iCol = iCol + 1
Cells(iRow, iCol).Value = DirObject.GetDetailsOf(DirObject.ParseName(MyFile.Name), 20) 'author
iRow = iRow + 1
Next
Set ShellObject = Nothing
Set DirObject = Nothing
Set MyObject = Nothing
Set MySource = Nothing
End Sub
Note that not all file types will have the author attribute.
Hi Catalin,
I amended my script accordingly but still got no author information, and the file list populates starting row 2 instead of row 3, I don't know why. Please refer the attached file and kindly check it out. Thanks.
Regards,
Julian
There is no attachment, please press the Start Upload button after you Add Files to the Upload Queue. Those 2 buttons are side by side, should be easy to see them.
What file types are in that target folder?
Another important info is your excel version, GetDetailsOf is not very reliable across versions, I tested the code on Eexcel 2016 and it works.
I got the error message "test.xlsm: Error 104 - You do not have permission to upload files". Do I need to apply some authorization any more. For your reference furthermore, I use Excel 2013 in 64-bit operating system and most of the files are Excel files in my target folder. I've collected a lot of them in last year from the on-line blogs, and of course part of them from your myonlinetrainghub, Therefore, I was trying to make some classifications by "author".
Send it to email then, there are some technical problems on forum, we are working on it.
Received the file, tested and it works on my computer.
What you should try, is to list all properties for a single file, maybe the author is in a different parameter on your version:
For j=0 to 20
Debug.Print DirObject.GetDetailsOf(DirObject.ParseName(MyFile.Name), j)
Next j
Because you disabled error checking, with On Error Resume Next, you cannot see the main error:
The iRow parameter starts from 0, because it does not have a start value, so when the loop starts, the first file is not listed because Cells(iRow, iCol) fails with 0 values. At the next loop, the iRow will be indexed (iRow=iRow+1), so the code will actually start listing data from the second file.
You have to set the initial start value for iRow, before starting the loop: iRow=2.
In fact, if you replace On Error resume Next with iRow=2, the code will work with no problem, no need to disable errors.
Catalin,
After running your script it's true the parameter is also "20" for the file author on my Excel 2013. However, could you please do me one more favor? As you can see from my sheet1, I put the value of argument "mySourcePath" of function ListMyFiles( ) on cell (B1) and cell (A1) for the argument "IncludeSubfolders" then populate the file list starting row 3, (row2 was reserved for heading). I found If IncludeSubfolders is true then the program would overwrite a lot of lines from the beginning of what already populated. I think you have explained it as mentioned above but be honest I could not catch you point fully. Therefore, could you please help me amend the script one more time for my following along? Thanks again for your great support.
Best regards,
Julian
Hi Julian,
Because the code structure is recursive, you have to add another argument to indicate which is the starting row, each time a new folder is analized.
Try this code:
Dim ShellObject As Object, MyObject As Object, MySource As Object, MyFile As Object, DirObject As Object, iCol As Byte
Set ShellObject = CreateObject("Shell.Application")
Set DirObject = ShellObject.Namespace(mySourcePath)
Set MyObject = CreateObject("Scripting.FileSystemObject")
Set MySource = MyObject.GetFolder(mySourcePath)
For Each MyFile In MySource.Files
iCol = 2
Cells(iRow, iCol).Value = MyFile.Path
iCol = iCol + 1
Cells(iRow, iCol).Value = MyFile.Name
iCol = iCol + 1
'Retrieve file extension
Cells(iRow, iCol).Value = Right(MyFile.Name, Len(MyFile.Name) - InStrRev(MyFile.Name, "."))
iCol = iCol + 1
Cells(iRow, iCol).Value = (MyFile.Size / 1024)
iCol = iCol + 1
Cells(iRow, iCol).Value = DirObject.GetDetailsOf(DirObject.ParseName(MyFile.Name), 20) 'author
iCol = iCol + 1
Cells(iRow, iCol).Value = MyFile.DateCreated
iCol = iCol + 1
Cells(iRow, iCol).Value = MyFile.DateLastModified
iRow = iRow + 1
Next
If IncludeSubfolders Then
For Each mySubFolder In MySource.SubFolders
Call ListMyFiles(mySubFolder.Path, True, iRow)
Next
End If
Set ShellObject = Nothing
Set DirObject = Nothing
Set MyObject = Nothing
Set MySource = Nothing
End Sub
As you can see in function arguments, Optional iRow As Long = 3 will set row 3 as the starting row. But when a subfolder is found, and the function is called again, in the function call provide the new starting row, otherwise it will start again from row 3, overwriting the previous lines:
Call ListMyFiles(mySubFolder.Path, True, iRow)
You can start looping through folders with the existing code you are already using:
Call ClearData
Call ListMyFiles(Range("B1"), Range("A1"))
Call HyperLinks
End Sub
Sorry, still got problems. I'm really frustrated after several days strugle. Could you please send me a complete file?
Sent by mail, forum upload is still not functional at this moment.
But it has exactly the same codes as the ones posted, should work.
Cheers,
Catalin
Have you tested the file? it got stucked on the line
Cells(iRow, iCol).Value = DirObject.GetDetailsOf(DirObject.ParseName(MyFile.Name), 20) 'author
and the error message read "Object variable or with block variable not set".
By the way, I found another issue - even without searching for the files in sub-folders, there is always one file (probably the first one) missing .
Hi Catalin,
After a whole night trial and error yesterday finally the main issue "retrieving the author" seemed to be solved right now. However please be reported here there are still 2 points remained to be tackled.
1. instead of hard code the target folder in the script, when I tried to get both auguments from cell A1 and B2, all the data in the column "Author" would not show up any more.
2. A dynamic range data cleaning also popped up a error message read "Method 'Range' of object 'Worksheet' failed"
Could you please help me fine tune it to close this case? Thanks again for your enthusiastic support.
Best regards,
Julian Chen
Hi Julian,
First, you will have to declare the arguments properly, otherwise they will be considered as Variants:
Sub ListMyFiles(mySourcePath As String, IncludeSubfolders As Boolean, Optional iRow As Long = 3)
The, when you call the function, send correct data types:
ListMyFiles CStr(Range("B1").Text), CBool(Range("A1").Text)
If you don't do that, you will send an object (a range object) to the function, instead of a string. When you hard type the path, that's clearly a string.
For the Clear range error, try to write the full reference, not just Range("A1:A2").ClearContents
Fully qualified references will return less errors: Worksheets("Sheet1").Range("A1:A2").ClearContents
I use the following script as a workaround to clear the dynamic range and it's workable:
Sub ClearData()
Range("A3:H3").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Range("a2").Select
End Sub
However, with regard to the auguments of function ListMyFiles( ), I amended the following script as you instructed:
ListMyFiles CStr(Range("B1").Text), CBool(Range("A1").Text)
Sub ListMyFiles(mySourcePath As String, IncludeSubfolders As Boolean, Optional iRow As Long = 3)
Dim ShellObject As Object, MyObject As Object, MySource As Object, MyFile As Object, DirObject As Object, iCol As Byte
Set ShellObject = CreateObject("Shell.Application")
Set DirObject = ShellObject.Namespace(mySourcePath)
Set MyObject = CreateObject("Scripting.FileSystemObject")
Set MySource = MyObject.GetFolder(mySourcePath)
On Error Resume Next
For Each MyFile In MySource.Files
iCol = 2
Cells(iRow, iCol).Value = MyFile.Path
iCol = iCol + 1...
then it would skip the portion of author accordingly. Please take a look what's going wrong. (I'm sending my file to you by email)
