Binaryworld - Get/Set file or folder's attribute using GetFileAttributesEx/SetFileAt ... [ VB -> Files & Folder ]

This article will show you how to use GetFileAttributesEx to retrive file/folder attributes which includes createtion date, last accessed/modiifed date and various attributes of file/folder.

Step-By-Step Example

- Create a standard exe project
- Add one drive control, one dir control, one file control and one listbox control
- Change Listbox Style=1 (Checkbox Items)
- Add the following code in form1

Click here to copy the following block

Option Explicit

Private Type FILETIME
  dwLowDateTime As Long
  dwHighDateTime As Long
End Type

Private Type WIN32_FILE_ATTRIBUTE_DATA
  dwFileAttributes As Long
  ftCreationTime As FILETIME
  ftLastAccessTime As FILETIME
  ftLastWriteTime As FILETIME
  nFileSizeHigh As Long
  nFileSizeLow As Long
End Type

Private Type SYSTEMTIME
  wYear As Integer
  wMonth As Integer
  wDayOfWeek As Integer
  wDay As Integer
  wHour As Integer
  wMinute As Integer
  wSecond As Integer
  wMilliseconds As Integer
End Type

Private Declare Function GetFileAttributesEx Lib "kernel32" Alias _
    "GetFileAttributesExA" (ByVal lpFileName As String, _
    ByVal fInfoLevelId As Long, wData As WIN32_FILE_ATTRIBUTE_DATA) _
    As Long

Private Declare Function SetFileAttributes Lib "kernel32" Alias "SetFileAttributesA" ( _
  ByVal lpFileName As String, ByVal dwFileAttributes As Long) As Long

Const FILE_ATTRIBUTE_ARCHIVE = &H20
Const FILE_ATTRIBUTE_COMPRESSED = &H800
Const FILE_ATTRIBUTE_DEVICE = &H40
Const FILE_ATTRIBUTE_DIRECTORY = &H10
Const FILE_ATTRIBUTE_ENCRYPTED = &H4000
Const FILE_ATTRIBUTE_HIDDEN = &H2
Const FILE_ATTRIBUTE_NORMAL = &H80
Const FILE_ATTRIBUTE_NOT_CONTENT_INDEXED = &H2000
Const FILE_ATTRIBUTE_OFFLINE = &H1000
Const FILE_ATTRIBUTE_READONLY = &H1
Const FILE_ATTRIBUTE_REPARSE_POINT = &H400
Const FILE_ATTRIBUTE_SPARSE_FILE = &H200
Const FILE_ATTRIBUTE_SYSTEM = &H4
Const FILE_ATTRIBUTE_TEMPORARY = &H100

Dim strLastSelectedPath As String
Dim IsCodeListCheck As Boolean

Private Sub Dir1_Change()
  File1.Path = Dir1.Path
  strLastSelectedPath = Dir1.Path
  Call ShowAttributesDemo

  Me.Caption = strLastSelectedPath
End Sub

Private Sub Dir1_Click()
  strLastSelectedPath = Dir1.List(Dir1.ListIndex)
  Call ShowAttributesDemo

  Me.Caption = strLastSelectedPath
End Sub

Private Sub Drive1_Change()
  Dir1.Path = Drive1.Drive
End Sub

Private Sub File1_Click()
  If File1.ListIndex < 0 Then MsgBox "Please select a file": Exit Sub
  strLastSelectedPath = Dir1.Path & "\" & File1.FileName
  Call ShowAttributesDemo

  Me.Caption = strLastSelectedPath
End Sub

Function ShowAttributesDemo()
  Dim ret As Long, i As Integer
  Dim w As WIN32_FILE_ATTRIBUTE_DATA
  Dim sAttribs As String

  ret = GetFileAttributesEx(strLastSelectedPath, 0&, w)  'we all have

  '//First uncheck all
  For i = 0 To List1.ListCount - 1
    IsCodeListCheck = True
    List1.Selected(i) = False
  Next

  If ret <> 0 Then
    If (w.dwFileAttributes And FILE_ATTRIBUTE_ARCHIVE) = FILE_ATTRIBUTE_ARCHIVE Then IsCodeListCheck = True: List1.Selected(0) = True
    If (w.dwFileAttributes And FILE_ATTRIBUTE_COMPRESSED) = FILE_ATTRIBUTE_COMPRESSED Then IsCodeListCheck = True: List1.Selected(1) = True
    If (w.dwFileAttributes And FILE_ATTRIBUTE_DEVICE) = FILE_ATTRIBUTE_DEVICE Then IsCodeListCheck = True: List1.Selected(2) = True
    If (w.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY Then IsCodeListCheck = True: List1.Selected(3) = True
    If (w.dwFileAttributes And FILE_ATTRIBUTE_ENCRYPTED) = FILE_ATTRIBUTE_ENCRYPTED Then IsCodeListCheck = True: List1.Selected(4) = True
    If (w.dwFileAttributes And FILE_ATTRIBUTE_HIDDEN) = FILE_ATTRIBUTE_HIDDEN Then IsCodeListCheck = True: List1.Selected(5) = True
    If (w.dwFileAttributes And FILE_ATTRIBUTE_NORMAL) = FILE_ATTRIBUTE_NORMAL Then IsCodeListCheck = True: List1.Selected(6) = True
    If (w.dwFileAttributes And FILE_ATTRIBUTE_NOT_CONTENT_INDEXED) = FILE_ATTRIBUTE_NOT_CONTENT_INDEXED Then IsCodeListCheck = True: List1.Selected(7) = True
    If (w.dwFileAttributes And FILE_ATTRIBUTE_OFFLINE) = FILE_ATTRIBUTE_OFFLINE Then IsCodeListCheck = True: List1.Selected(8) = True
    If (w.dwFileAttributes And FILE_ATTRIBUTE_READONLY) = FILE_ATTRIBUTE_READONLY Then IsCodeListCheck = True: List1.Selected(9) = True
    If (w.dwFileAttributes And FILE_ATTRIBUTE_REPARSE_POINT) = FILE_ATTRIBUTE_REPARSE_POINT Then IsCodeListCheck = True: List1.Selected(10) = True
    If (w.dwFileAttributes And FILE_ATTRIBUTE_SPARSE_FILE) = FILE_ATTRIBUTE_SPARSE_FILE Then IsCodeListCheck = True: List1.Selected(11) = True
    If (w.dwFileAttributes And FILE_ATTRIBUTE_SYSTEM) = FILE_ATTRIBUTE_SYSTEM Then IsCodeListCheck = True: List1.Selected(12) = True
    If (w.dwFileAttributes And FILE_ATTRIBUTE_TEMPORARY) = FILE_ATTRIBUTE_TEMPORARY Then IsCodeListCheck = True: List1.Selected(13) = True
  End If
End Function

Private Sub Form_Load()
  strLastSelectedPath = Dir1.Path
  Me.Caption = strLastSelectedPath

  List1.AddItem "ARCHIVE": List1.ItemData(0) = FILE_ATTRIBUTE_ARCHIVE
  List1.AddItem "COMPRESSED": List1.ItemData(1) = FILE_ATTRIBUTE_COMPRESSED
  List1.AddItem "DEVICE": List1.ItemData(2) = FILE_ATTRIBUTE_DEVICE
  List1.AddItem "DIRECTORY": List1.ItemData(3) = FILE_ATTRIBUTE_DIRECTORY
  List1.AddItem "ENCRYPTED": List1.ItemData(4) = FILE_ATTRIBUTE_ENCRYPTED
  List1.AddItem "HIDDEN": List1.ItemData(5) = FILE_ATTRIBUTE_HIDDEN
  List1.AddItem "NORMAL": List1.ItemData(6) = FILE_ATTRIBUTE_NORMAL
  List1.AddItem "NOT INDEXED": List1.ItemData(7) = FILE_ATTRIBUTE_NOT_CONTENT_INDEXED
  List1.AddItem "OFFLINE": List1.ItemData(8) = FILE_ATTRIBUTE_OFFLINE
  List1.AddItem "READONLY": List1.ItemData(9) = FILE_ATTRIBUTE_READONLY
  List1.AddItem "REPARSE POINT": List1.ItemData(10) = FILE_ATTRIBUTE_REPARSE_POINT
  List1.AddItem "SPARSE FILE": List1.ItemData(11) = FILE_ATTRIBUTE_SPARSE_FILE
  List1.AddItem "SYSTEM": List1.ItemData(12) = FILE_ATTRIBUTE_SYSTEM
  List1.AddItem "TEMPORARY": List1.ItemData(13) = FILE_ATTRIBUTE_TEMPORARY
End Sub

Private Sub List1_ItemCheck(Item As Integer)
  '//This will not execute SetAttributesDemo if List1.Selected property is set
  If IsCodeListCheck = True Then IsCodeListCheck = False: Exit Sub
  Call SetAttributesDemo

  '//Reset the flag
  IsCodeListCheck = False
End Sub

Sub SetAttributesDemo()
  Dim lFlag As Long, i As Integer, ret As Long

  If List1.ListIndex < 0 Then MsgBox "Please select attribute to change": Exit Sub

  If List1.Text = "COMPRESSED" Or _
      List1.Text = "DEVICE" Or _
      List1.Text = "DIRECTORY" Or _
      List1.Text = "ENCRYPTED" Or _
      List1.Text = "REPARSE POINT" Or _
      List1.Text = "SPARSE FILE" Then

    MsgBox "Sorry this attibute can not be changed using SetFileAttributes API"
    IsCodeListCheck = True
    List1.Selected(List1.ListIndex) = False '//Unselect it
  Else
    '//Now build Attribut flag from selected attributes
    For i = 0 To List1.ListCount - 1
      If List1.Selected(i) = True Then
        lFlag = lFlag Or List1.ItemData(i) '//Update Attribute flag
      End If
    Next

    '//Now set the attribute(s) to the last selected file/folder
    ret = SetFileAttributes(strLastSelectedPath, lFlag)
    If ret = 0 Then
      MsgBox "Error in SetFileAttributes : Error#" & Err.LastDllError, vbCritical
    Else
      MsgBox "Attributes set successfully", vbInformation
    End If

  End If
End Sub