VBA question

R

rawr19911

Board Regular
Joined
Jan 21, 2020
Messages
91
Office Version
  1. 2016
I tried a few times to figure this out but can't figure out how to get Last Saved By name in excel-

.Cells(, 1).Value = fil.Name
.Cells(, 2).Value = fld.Path
.Cells(, 3).Value = Right(fil.Name, Len(fil.Name) - InStrRev(fil.Name, "."))
.Cells(, 4).Value = fil.DateCreated
.Cells(, 5).Value = fil.DateLastAccessed
.Cells(, 6).Value = fil.DateLastModified
.Cells(, 7).Value = fil.LastAuthor (this doesn't work)

here is the full VBA code without the last author / last saved by
Option Explicit
Sub AllFileFolder()
Dim strPath As String
Dim sht As Worksheet
Dim rng As Range
Dim Path As String
Dim fso As Object
Dim fld As Object
Dim fil As Object

strPath = "\\DrivePath"

Set sht = ActiveWorkbook.Worksheets.Add

Set rng = sht.Cells(1, 1)
rng.Resize(, 6).Value = Array("FileName", "FileLocation", "Extension", "CreationDate", "LastAccessDate", "LastModficationDate")

Set fso = CreateObject("Scripting.FileSystemObject")

Set fld = fso.GetFolder(strPath)

getFilesFromFolder fld, rng

MsgBox "Done", vbOKOnly + vbInformation, "Done"
End Sub
Private Sub getFilesFromFolder(fld As Object, rng As Range)
Dim subfld As Object
Dim fil As Object

On Error GoTo ErrHandler

For Each fil In fld.Files

DoEvents

Set rng = rng.Offset(1)

With rng
.Cells(, 1).Value = fil.Name
.Cells(, 2).Value = fld.Path
.Cells(, 3).Value = Right(fil.Name, Len(fil.Name) - InStrRev(fil.Name, "."))
.Cells(, 4).Value = fil.DateCreated
.Cells(, 5).Value = fil.DateLastAccessed
.Cells(, 6).Value = fil.DateLastModified
End With
Next fil


For Each subfld In fld.SubFolders

getFilesFromFolder subfld, rng
Next subfld
ErrHandler:

End Sub
 

Excel Facts

Did you know Excel offers Filter by Selection?
Add the AutoFilter icon to the Quick Access Toolbar. Select a cell containing Apple, click AutoFilter, and you will get all rows with Apple
Sort by date Sort by votes
Maybe like below:
VBA Code: 
Sub AllFileFolder()
    Dim sPath As String, sht As Worksheet, rng As Range
    Dim fso As Object, fld As Object, fil As Object, subfld As Object
    
    sPath = "\\DrivePath\" ' needs to end with a \
    
    Set sht = ActiveWorkbook.Worksheets.Add
    Set rng = sht.Cells(1, 1)
    rng.Resize(, 6) = Array("FileName", "FileLocation", "Extension", "CreationDate", "LastAccessDate", "LastModficationDate")
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set fld = fso.GetFolder(sPath)
    
NextSFold:
    For Each fil In fld.Files
        Set rng = rng.Offset(1)
        With rng
            .Resize(, 6) = GetAuthorFromShell(fld & "\", fil.Name)
        End With
    Next fil
    
    For Each subfld In fld.SubFolders
        Set fld = fso.GetFolder(subfld.Path)
        GoTo NextSFold
    Next subfld
End Sub

Function GetAuthorFromShell(strPath As String, strFileName As String) As Variant
    Dim nm As String, pth As String, typ As String, dcr As Date, dac As Date, dmod As Date
    Dim varPath As Variant, varFileName As Variant
    Dim objShell As Object, objFolder As Object
    
    varPath = strPath
    varFileName = strFileName

    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.Namespace(varPath)

    With objFolder
        nm = .getdetailsof(.Items.Item(varFileName), 0)
        pth = varPath & varFileName
        typ = .getdetailsof(.Items.Item(varFileName), 2)
        dcr = CDate(.getdetailsof(.Items.Item(varFileName), 4))
        dac = CDate(.getdetailsof(.Items.Item(varFileName), 5))
        dmod = CDate(.getdetailsof(.Items.Item(varFileName), 3))
    End With
    
    GetAuthorFromShell = Array(nm, pth, typ, dcr, dac, dmod)
End Function
 
Upvote 0
Georgiboy said:
Maybe like below:
VBA Code: 
Sub AllFileFolder()
    Dim sPath As String, sht As Worksheet, rng As Range
    Dim fso As Object, fld As Object, fil As Object, subfld As Object
   
    sPath = "\\DrivePath\" ' needs to end with a \
   
    Set sht = ActiveWorkbook.Worksheets.Add
    Set rng = sht.Cells(1, 1)
    rng.Resize(, 6) = Array("FileName", "FileLocation", "Extension", "CreationDate", "LastAccessDate", "LastModficationDate")
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set fld = fso.GetFolder(sPath)
   
NextSFold:
    For Each fil In fld.Files
        Set rng = rng.Offset(1)
        With rng
            .Resize(, 6) = GetAuthorFromShell(fld & "\", fil.Name)
        End With
    Next fil
   
    For Each subfld In fld.SubFolders
        Set fld = fso.GetFolder(subfld.Path)
        GoTo NextSFold
    Next subfld
End Sub

Function GetAuthorFromShell(strPath As String, strFileName As String) As Variant
    Dim nm As String, pth As String, typ As String, dcr As Date, dac As Date, dmod As Date
    Dim varPath As Variant, varFileName As Variant
    Dim objShell As Object, objFolder As Object
   
    varPath = strPath
    varFileName = strFileName

    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.Namespace(varPath)

    With objFolder
        nm = .getdetailsof(.Items.Item(varFileName), 0)
        pth = varPath & varFileName
        typ = .getdetailsof(.Items.Item(varFileName), 2)
        dcr = CDate(.getdetailsof(.Items.Item(varFileName), 4))
        dac = CDate(.getdetailsof(.Items.Item(varFileName), 5))
        dmod = CDate(.getdetailsof(.Items.Item(varFileName), 3))
    End With
   
    GetAuthorFromShell = Array(nm, pth, typ, dcr, dac, dmod)
End Function
Click to expand...

this isnt giving me the last authors still - its pulling in much of the same information i was already getting- however; this list is smaller then what i was geting as well so its not runign all subfolders, i think it is stopign with a last author cant be found even though its not placing it on the excel form ( some files dont have authors or last authors)
 
Upvote 0
I was working to your original code, where I did not see anything about returning an author:
VBA Code: 
.Cells(, 1).Value = fil.Name
.Cells(, 2).Value = fld.Path
.Cells(, 3).Value = Right(fil.Name, Len(fil.Name) - InStrRev(fil.Name, "."))
.Cells(, 4).Value = fil.DateCreated
.Cells(, 5).Value = fil.DateLastAccessed
.Cells(, 6).Value = fil.DateLastModified

If the code is ending due to missing information, then you can try the below where it should pass over missing info:
VBA Code: 
Function GetAuthorFromShell(strPath As String, strFileName As String) As Variant
    Dim nm As String, pth As String, typ As String, dcr As Date, dac As Date, dmod As Date
    Dim varPath As Variant, varFileName As Variant
    Dim objShell As Object, objFolder As Object
    
    varPath = strPath
    varFileName = strFileName

    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.Namespace(varPath)

    With objFolder
        On Error Resume Next
            nm = .getdetailsof(.Items.Item(varFileName), 0)
            pth = varPath & varFileName
            typ = .getdetailsof(.Items.Item(varFileName), 2)
            dcr = CDate(.getdetailsof(.Items.Item(varFileName), 4))
            dac = CDate(.getdetailsof(.Items.Item(varFileName), 5))
            dmod = CDate(.getdetailsof(.Items.Item(varFileName), 3))
        On Error GoTo 0
    End With
    
    GetAuthorFromShell = Array(nm, pth, typ, dcr, dac, dmod)
End Function

The function is only named: 'GetAuthorFromShell' as it had been re-purposed, where the original code was returning the author.
 
Upvote 0
Below is a list of the numbers that can be used to get information out of:
.getdetailsof(.Items.Item(varFileName), 0)

The 0 above is returning the file name:

[0] = Name
[1] = Size
[2] = Item type
[3] = Date modified
[4] = Date created
[5] = Date accessed
[6] = Attributes
[7] = Offline status
[8] = Availability
[9] = Perceived type
[10] = Owner
[11] = Kind
[12] = Date taken
[13] = Contributing artists
[14] = Album
[15] = Year
[16] = Genre
[17] = Conductors
[18] = Tags
[19] = Rating
[20] = Authors
[21] = Title
[22] = Subject
[23] = Categories
[24] = Comments
[25] = Copyright
[26] = #
[27] = Length
[28] = Bit rate
[29] = Protected
[30] = Camera model
[31] = Dimensions
[32] = Camera maker
[33] = Company
[34] = File description
[35] = Program name
[36] = Duration
[37] = Is online
[38] = Is recurring
[39] = Location
[40] = Optional attendee addresses
[41] = Optional attendees
[42] = Organizer address
[43] = Organizer name
[44] = Reminder time
[45] = Required attendee addresses
[46] = Required attendees
[47] = Resources
[48] = Meeting status
[49] = Free/busy status
[50] = Total size
[51] = Account name
 
Upvote 0
Try it as below:
VBA Code: 
Sub AllFileFolder()
    Dim sPath As String, sht As Worksheet, rng As Range
    Dim fso As Object, fld As Object, fil As Object, subfld As Object
    
    sPath = "\\DrivePath\" ' needs to end with a \
    
    Set sht = ActiveWorkbook.Worksheets.Add
    Set rng = sht.Cells(1, 1)
    rng.Resize(, 7) = Array("FileName", "FileLocation", "Extension", "CreationDate", "LastAccessDate", "LastModficationDate", "LastSavedBy")
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set fld = fso.GetFolder(sPath)
    
NextSFold:
    For Each fil In fld.Files
        Set rng = rng.Offset(1)
        With rng
            .Resize(, 7) = GetAuthorFromShell(fld & "\", fil.Name)
        End With
    Next fil
    
    For Each subfld In fld.SubFolders
        Set fld = fso.GetFolder(subfld.Path)
        GoTo NextSFold
    Next subfld
End Sub

Function GetAuthorFromShell(strPath As String, strFileName As String) As Variant
    Dim nm As String, pth As String, typ As String, dcr As Date, dac As Date, dmod As Date, lsby As String
    Dim varPath As Variant, varFileName As Variant
    Dim objShell As Object, objFolder As Object
    
    varPath = strPath
    varFileName = strFileName

    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.Namespace(varPath)

    With objFolder
        On Error Resume Next
            nm = .getdetailsof(.Items.Item(varFileName), 0)
            pth = varPath & varFileName
            typ = .getdetailsof(.Items.Item(varFileName), 2)
            dcr = CDate(.getdetailsof(.Items.Item(varFileName), 4))
            dac = CDate(.getdetailsof(.Items.Item(varFileName), 5))
            dmod = CDate(.getdetailsof(.Items.Item(varFileName), 3))
            lsby = .getdetailsof(.Items.Item(varFileName), 10)
        On Error GoTo 0
    End With
    
    GetAuthorFromShell = Array(nm, pth, typ, dcr, dac, dmod, lsby)
End Function
 
Upvote 0
Solution
You must log in or register to reply here.

Similar threads

R
  • Question Question
Enhancement for folder/file/subfolder lookup automation
Replies
3
Views
359
rawr19911
R
C
  • Question Question
Need to add to my search worksheet
Replies
1
Views
116
craigwojo
C
mmn1000
  • Question Question
List folders and files
Replies
1
Views
846
Fuji
F
S
  • Question Question
Adding a new field to the results of my "list the folders inside a specific folder" code
Replies
2
Views
323
John_w
J
C
  • Question Question
Need to search in all files within all folders also.
Replies
5
Views
454
Domenic
D

Forum statistics

Threads
1,224,827
Messages
6,181,200
Members
453,022
Latest member
RobertV1609

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top