Function IsOpenedExclusive() As String
    IsOpenedExclusive = False
    Dim rs As ADODB.Recordset
    Set rs = con.OpenSchema(adSchemaProviderSpecific, , "{947bb102-5d43-11d1-bdbf-00c04fb92675}")
    
    Dim strUsers As String
    Dim intUsers As Integer
    Do While Not rs.EOF
        strUsers = strUsers & vbCrLf & Left(rs.Fields(1), Len(Trim(rs.Fields(1))) - 1) & "@" & Left(rs.Fields(0), Len(Trim(rs.Fields(0))) - 1)
        intUsers = intUsers + 1
        rs.MoveNext
    Loop
    rs.Close
    Set rs = Nothing
    
    If intUsers > 1 Then
        IsOpenedExclusive = strUsers
        Exit Function
    End If
    IsOpenedExclusive = True
End Function