VBA question

[rawr19911]

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

 

[Georgiboy]

Perhaps the answer in the thread below will help:
Dynamic File - Last Saved by

 

[rawr19911]

Perhaps the answer in the thread below will help:
Dynamic File - Last Saved by

thanks- i looked at the thread not sure how to put it in the code that I'm not sure how to put it in the code im already using.

 

[Georgiboy]

Maybe like below:

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

 

[rawr19911]

Maybe like below:

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

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)

 

[Georgiboy]

I was working to your original code, where I did not see anything about returning an author:

.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:

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.

 

[Georgiboy]

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

 

[Georgiboy]

I was working to your original code, where I did not see anything about returning an author:

I see it in your original question now, will have to have a look for you tomorrow.

 

[rawr19911]

I see it in your original question now, will have to have a look for you tomorrow.

will look foward tomorrow YOU ARE AMAZING!! thanks, yeah today has been a BUSY BUSY day- i really appricate you so much!

 

[Georgiboy]

Try it as below:

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