1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60
| Public Function DernierCreateur(strPathComplet As String) As String
' Shell32 objects
Dim objShell As Shell32.Shell
Dim objFolder As Shell32.Folder
Dim objFolderItem As Shell32.FolderItem
' Other objects
Dim strPath As String
Dim strFileName As String
Dim i As Integer
strPath = strPathComplet
' If the file does not exist then quit out
If Dir(strPath) = "" Then Exit Function
' Parse the file name out from the folder path
i = InStrRev(strPath, "\")
strFileName = Mid$(strPath, i + 1)
strPath = Left$(strPath, i - 1)
' Set up the shell32 Shell object
Set objShell = New Shell
' Set the shell32 folder object
Set objFolder = objShell.Namespace(strPath)
' If we can find the folder then ...
If (Not objFolder Is Nothing) Then
' Set the shell32 file object
Set objFolderItem = objFolder.ParseName(strFileName)
' If we can find the file then get the file attributes
If (Not objFolderItem Is Nothing) Then
' GetFileAttributes.Name = objFolder.GetDetailsOf(objFolderItem, 0)
' GetFileAttributes.Size = objFolder.GetDetailsOf(objFolderItem, 1)
' GetFileAttributes.FileType = objFolder.GetDetailsOf(objFolderItem, 2)
' GetFileAttributes.DateModified = CDate(objFolder.GetDetailsOf(objFolderItem, 3))
' GetFileAttributes.DateCreated = CDate(objFolder.GetDetailsOf(objFolderItem, 4))
' GetFileAttributes.DateAccessed = CDate(objFolder.GetDetailsOf(objFolderItem, 5))
' GetFileAttributes.Attributes = objFolder.GetDetailsOf(objFolderItem, 6)
' GetFileAttributes.Status = objFolder.GetDetailsOf(objFolderItem, 7)
DernierCreateur = objFolder.GetDetailsOf(objFolderItem, 10)
' DernierCreateur = objFolder.GetDetailsOf(objFolderItem, 20)
' GetFileAttributes.Title = objFolder.GetDetailsOf(objFolderItem, 21)
' GetFileAttributes.Subject = objFolder.GetDetailsOf(objFolderItem, 22)
' GetFileAttributes.Category = objFolder.GetDetailsOf(objFolderItem, 23)
End If
Set objFolderItem = Nothing
End If
Set objFolder = Nothing
Set objShell = Nothing
End Function |
Partager