Set Reg = New Regexp : Reg.IgnoreCase = True
Reg.Pattern = "^(do[ct][xm]?|xl[st][xm]?|p[op]t[xm]?|vsd)$"
If Reg.Test(Mid(FileName, InStrRev(FileName, ".") + 1)) Then
  Set Reg  = Nothing : SD = "System.Document."
  Set File = CreateObject("Shell.Application").NameSpace(0).ParseName(FileName)
  For Each Ct in Array("DocLastAuthor", SD & "RevisionNumber", SD & "Version",_
  "Manager", SD & "TotalEditingTime", SD & "ByteCount", "DocPageCount",_
  "DocWordCount", SD & "CharacterCount", "DocLineCount", SD & "ParagraphCount",_
  "DocSlideCount", "DocNoteCount", SD & "HiddenSlideCount", SD & "MultimediaClipCount",_
  SD & "PresentationFormat", "DocTemplate", "Scale", "LinksUpToDate", "System.Language")
     If i = 4 Then Pt1 = "FTime(" : Pt2 = ")" Else Pt1 = "" : Pt2 = ""
     Execute "Content" & i & "=" & Pt1 & "File.ExtendedProperty(""" & Ct & """)" & Pt2
     i = i + 1
  Next : Set File = Nothing
End If

Function FTime(T)
  T = CSng(T)/10000000
  If T < 32768 Then
    FTime = Right("0" & TimeSerial(0, 0, Int(T)), 8)
  Else
    D = Int(T/86400) : H1 = T  - D * 86400
    H = Int(H1/3600) : M1 = H1 - H * 3600
    M = Int(M1/60)   : S  = M1 - M * 60
    If D = 0 Then D = "" Else If _
    Right(D,1) = 1 And Right(D,2) <> 11 Then _
    D = D & " сутки " Else D = D & " суток "
    FTime = D & Right("0" & TimeSerial(H, M, S), 8)
  End If
End Function

Set Reg = New Regexp : Reg.IgnoreCase = True
Reg.Pattern = "^(do[ct][xm]?|xl[st][xm]?|p[op]t[xm]?|vsd)$"
If Reg.Test(Mid(FileName, InStrRev(FileName, ".") + 1)) Then
  Set Reg  = Nothing
  Set File = CreateObject("Shell.Application").NameSpace(0).ParseName(FileName)
  For Each Ct in Split("Attributes System.OfflineAvailability System.OfflineStatus System.IsShared")
    Execute "Content" & i & " = File.ExtendedProperty(""" & Ct & """)" : i = i + 1
  Next : Set File = Nothing
End If