Друзья, добрый день! Подскажите, пожалуйста, хотелось бы, чтобы в случае увольнения определенного сотрудника, макрос переставал работать. Сейчас сделал такое в начале процедуры:
Код
If (Int(CDbl(Date)) - Int(CDbl(#7/31/2021#))) > 90 Then Exit Sub
Т.е. через 90 дней перестанет работать, если я вручную дату не подправлю. Но хотелось бы красивого, универсального решения.
Как я это предполагаю должно работать: у сотрудника есть почтовый адрес, пусть будет IvanovBO@company.ru. Если сотрудник уволен, то у него в Outlook будет такое: Можно ли как-нибудь к этому привязаться? Чтобы при открытии книги, проверялось, жива ли почта. Если нет, то End Sub.
Либо еще такой вариант, есть корпоративный портал, где если вписать ФИО сотрудника, получаем по нему информацию. Если уволен, то будет "найдено 0 сотрудников" соответственно.
Портал
Или принимаются другие решения по данному вопросу, может я не туда думаю
не тратьте время на пакости в случае увольнения — обычно решения сами перестанут работать без поддержки, т.к. обойти ВСЕ возможные кривые вводы пользователей практически невозможно
Это уже не говоря про приличия, что так нехорошо и т.д. — так быстро тему в оффтоп утащит
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
evgeniygeo, не пробовал, попробую, но мне кажется, это очень долго) хотелось бы, чтобы эта проверка занимала минимум времени. БМВ, чтобы не работало у остальных, ну или по-другому У ВСЕХ вообще...у уволенного сотрудника все равно доступа к этому файлу уже не будет) Jack Famous, так-то оно может и так) может и не буду ничего такого делать, просто когда мне в голову приходит какая-то мысль и я не могу ее реализовать, мне становится интересно как ее можно реализовать, чтобы на случай, если это была бы не просто пакость, а необходимость, мочь ее сделать.
whateverlover написал: если это была бы не просто пакость, а необходимость, мочь ее сделать.
Если вы задаетесь таким вопросом то это будет мелкая пакость, которая элементарно исправляется. Скорее всего есть LDAP, и пользователь блокируется. Значит можно получить данные об этом. Пользователь есть и активен - работает. Нет или заблокирован - не работает. Успехов в бесполезном начинании.
whateverlover, тогда вопрос сводится к "Как узнать, уволен ли сотрудник". Ведь, если это определено, то запретить выполнение макроса вы можете - верно? Как по мне, проверки времени/даты вполне для "полевого" решения достаточно
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
Ну если например Вы хотите после своего увольнения всё порушить - держите файл у себя, сами и удалите в последний день, или после Вас комп техники унесут/почистят. Если наоборот - можно там в настройках сделать привязку к определённым юзерам/машинам. Будет типа проверки по LDAP. Т.е. работать смогут только записанные в настройках юзеры на разрешённых машинах и в этой сети. Но это конечно всё для несведущих людей. Впрочем таких абсолютное большинство...
Создаете себе гуглтаблицу, открываете чтение по ссылке. В ней в А1 = скажем 1 При запуске вашего эксель файла на рабочем (на любом собственно) компе - читаем гуглтаблицу Если А1 = 1 = выход. Если А1 не единица = закрыть файл с которого запущен макрос, или закрыть все книги, или очистить данные в открытых книгах+сохранить+закрыть... Насколько фантазии хватит...
Вдруг кому пригодится, нашел такое решение (проверяет есть ли юзер с переданными фамилией и именем):
Код
Sub Main()
Call AD_Get_Info("Ivanov", "Ivan")
End Sub
Function AD_Get_Info(ByVal sFirst As String, sLast As String) As Variant
'Get specific AD/LDAP user info for a given first and last name.
Dim oCmd As Object, oConn As Object, oRecSet As Object, objField As Object
'Set up ADO query and excute to find group matches
Set oCmd = CreateObject("ADODB.Command")
Set oConn = CreateObject("ADODB.Connection")
Set oRecSet = CreateObject("ADODB.Recordset")
oConn.Open "Provider=ADsDSOObject;"
'What to get and filter criteria
oCmd.CommandText = "SELECT mail, distinguishedname, name, samaccountname from 'LDAP://" & GetNC & "' WHERE objectCategory = 'user' and sn = '" & sLast & "' and givenName = '" & sFirst & "'"
oCmd.activeconnection = oConn
Set oRecSet = oCmd.Execute 'Go get the info if it exists!
If oRecSet.EOF = True And oRecSet.BOF = True Then Exit Function 'Nothing found
For Each objField In oRecSet.Fields
Debug.Print objField.Name & " = " & objField.Value
DoEvents
Next objField
oConn.Close
Set oRecSet = Nothing
Set oConn = Nothing
Set oCmd = Nothing
End Function
Function GetNC()
Dim objRoot As Object
Set objRoot = GetObject("LDAP://RootDSE")
GetNC = objRoot.get("defaultNamingContext")
Set objRoot = Nothing
End Function
whateverlover, Мы у себя не удаляем, а блокируем. Найденный вами скрипт это не проверяет. при этом в синтакисие SQL который используется в запросе, было помнится не просто указать сравнение бита в одном из атрибутов (userAccountControl). проще использовать синтаксис LDAP фильтров (!userAccountControl:1.2.840.113556.1.4.803:=2) , это сразу даст только активные записи В целом и по имени с фамилией искать не супер. Учетная запись уникальна (SamAccountName). А далее просто oRecSet.RecordsCount кажется сравнить с 0. 0 значит таких учеток нет.