Option Explicit

Private Declare Function GetFileSecurity Lib "advapi32.dll" Alias "GetFileSecurityA" (ByVal lpFileName As String, ByVal RequestedInformation As Long, pSecurityDescriptor As Byte, ByVal nLength As Long, lpnLengthNeeded As Long) As Long
Private Declare Function LookupAccountSid Lib "advapi32.dll" Alias "LookupAccountSidA" (ByVal lpSystemName As String, ByVal Sid As Long, ByVal name As String, cbName As Long, ByVal ReferencedDomainName As String, cbReferencedDomainName As Long, peUse As Long) As Long
Private Declare Function GetSecurityDescriptorOwner Lib "advapi32.dll" (pSecurityDescriptor As Any, pOwner As Long, lpbOwnerDefaulted As Long) As Long
Private Declare Function lstrlenW Lib "kernel32" (ByVal lpString As Long) As Long

Private Const OWNER_SECURITY_INFORMATION = &H1
Private Const ERROR_INSUFFICIENT_BUFFER =  122 &

Private Function GetFileOwner(ByVal sFileName As String) As String
    Dim sizeSD As Long, sdBuf() As Byte, pOwner As Long, deUse As Long, bSuccess As Long
    Dim sFileOwner As String, cbFileOwner As Long
    Dim sDomainName As String, cbDomainName As Long
    Dim sServer As String
    
    'Local server
    sServer = vbNullString
    
    'step 1: call GetFileSecurity to get the size of the buffer required
    bSuccess = GetFileSecurity(sFileName, OWNER_SECURITY_INFORMATION,  0 ,  0 &, sizeSD)

    If (bSuccess =  0 ) And (Err.LastDllError = ERROR_INSUFFICIENT_BUFFER) Then
        
        'step 2: create buffer of required size and call again
        ReDim sdBuf( 0  To sizeSD -  1 ) As Byte
        bSuccess = GetFileSecurity(sFileName, OWNER_SECURITY_INFORMATION, sdBuf( 0 ), sizeSD, sizeSD)
                                 
        If (bSuccess <>  0 ) Then
    
         'step 3: obtain owner's SID from the security descriptor
         If GetSecurityDescriptorOwner(sdBuf( 0 ), pOwner,  0 &) =  1  Then
                   
            'step 4: call LookupAccountSid twice to get the name of the account and the first domain on which this SID is found;
            'the first call gets the correct buffer size, the second gets the data
            bSuccess = LookupAccountSid(sServer, pOwner, sFileOwner, cbFileOwner, sDomainName, cbDomainName, deUse)
                            
            If (bSuccess =  0 ) And (Err.LastDllError = ERROR_INSUFFICIENT_BUFFER) Then
                'fill buffers and call again
                sFileOwner = Space(cbFileOwner)
                sDomainName = Space(cbDomainName)

                If LookupAccountSid(sServer, pOwner, sFileOwner, cbFileOwner, sDomainName, cbDomainName, deUse) =  1  Then
                     GetFileOwner = Left(sFileOwner, cbFileOwner)
                End If
            End If
         End If
      End If
   End If
End Function