Единственный, полезный и реально рабочий механизм это: Оповещение пользователей о окончании срока пароля по почте.

Столкнулись с ситуёвиной: ни всегда Windows напоминает о окончании срока действия пароля. Толи косяк перехода домена с 2000 на 2003 и далее на 2008. Толи просто косяки самих рабочих станций, начиная от XP и заканчивая Windows10. Но факт таков: оповещения реально не приходит. А не замутить ли Оповещение пользователей о окончании срока пароля по почте ?

Решено: принудительно, всем )

Требования :

Приходит всем кто имеет почтовый ящик.
Оповещение 4 раза: за 7 дней, за 5 , за 3 и за сутки. Последнее выделить текстом и цветом.

Мысль следующая:

Отобрать из пользователей всех живых и в зависимости от срока окончания пароля отсылать соответствующее письмо. Отправлять, не мудря костылей, обычным заданием с контроллера домена, либо с самого почтового сервера.

Создаём задания на оповещение пользователей о окончании срока пароля.

Option Explicit

Dim adoCommand, adoConnection, strBase, strFilter, strAttributes
Dim objRootDSE, strDNSDomain, strQuery, adoRecordset
Dim dtmDate1, dtmDate2, intDays, strName, strEmail, dtmDaysLeft
Dim lngSeconds1, str64Bit1, lngSeconds2, str64Bit2
Dim objShell, lngBiasKey, lngBias, k
Dim objDomain, objMaxPwdAge, lngHighAge, lngLowAge, sngMaxPwdAge
Dim objDate, dtmPwdLastSet, dtmExpires
Dim arrEmails, strItem, strPrefix

' Количество дней до истечения пароля 
intDays = 7

' Определяем политику максимального срока действия пароля домена в днях.
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("DefaultNamingContext")
Set objDomain = GetObject("LDAP://" & strDNSDomain)
Set objMaxPwdAge = objDomain.MaxPwdAge

' Учетная запись для ошибки в методах свойства IADslargeIntege.
lngHighAge = objMaxPwdAge.HighPart
lngLowAge = objMaxPwdAge.LowPart
If (lngLowAge < 0) Then
    lngHighAge = lngHighAge + 1
End If
' Преобразование из 100-наносекундных интервалов в дни.
sngMaxPwdAge = -((lngHighAge * 2^32) _
    + lngLowAge)/(600000000 * 1440)

' Определяем дату последнего изменения пароля,
' исключая пользователей, чей пароль уже истек.
dtmDate1 = DateAdd("d", - sngMaxPwdAge, Now())

' Определяем дату последнего изменения пароля,
' срок действия пароля истекал в будущем.
dtmDate2 = DateAdd("d", intDays - sngMaxPwdAge, Now())

' Получение смещения локального часового пояса от реестра компьютера..
Set objShell = CreateObject("Wscript.Shell")
lngBiasKey = objShell.RegRead("HKLM\System\CurrentControlSet\Control\" _
    & "TimeZoneInformation\ActiveTimeBias")
If (UCase(TypeName(lngBiasKey)) = "LONG") Then
    lngBias = lngBiasKey
ElseIf (UCase(TypeName(lngBiasKey)) = "VARIANT()") Then
    lngBias = 0
    For k = 0 To UBound(lngBiasKey)
        lngBias = lngBias + (lngBiasKey(k) * 256^k)
    Next
End If

' Преобразования типа datetime в формате UTC.
dtmDate1 = DateAdd("n", lngBias, dtmDate1)
dtmDate2 = DateAdd("n", lngBias, dtmDate2)

' Поиск количества секунд, прошедших с 1/1/1601 на эти даты.
lngSeconds1 = DateDiff("s", #1/1/1601#, dtmDate1)
lngSeconds2 = DateDiff("s", #1/1/1601#, dtmDate2)

'Преобразовать количество секунд в строку
'и преобразовать в 100-наносекундных интервалы.
str64Bit1 = CStr(lngSeconds1) & "0000000"
str64Bit2 = CStr(lngSeconds2) & "0000000"

' Настройка объектов ADO.
Set adoCommand = CreateObject("ADODB.Command")
Set adoConnection = CreateObject("ADODB.Connection")
adoConnection.Provider = "ADsDSOObject"
adoConnection.Open "Active Directory Provider"
Set adoCommand.ActiveConnection = adoConnection

' Поиск по всему домену Active Directory.
strBase = "<LDAP://" & strDNSDomain & ">"

' Фильтр по объектам пользователей, 
' срок действия которых истекает между, 
' дата указана, 
' учетная запись не отключена, 
' пароль не имеет срок действия, 
' пароль не требуется не установлено,
' и пароль не может быть изменен не установлен.
strFilter = "(&(objectCategory=person)(objectClass=user)" _
    & "(pwdLastSet>=" & str64Bit1 & ")" _
    & "(pwdLastSet<=" & str64Bit2 & ")" _
    & "(!userAccountControl:1.2.840.113556.1.4.803:=2)" _
    & "(!userAccountControl:1.2.840.113556.1.4.803:=65536)" _
    & "(!userAccountControl:1.2.840.113556.1.4.803:=32)" _
    & "(!userAccountControl:1.2.840.113556.1.4.803:=48))"

' Список значений атрибутов с разделителями-запятыми для отбора.
strAttributes = "sAMAccountName,mail,proxyAddresses,pwdLastSet"

' Построение синтаксиса запроса протокола LDAP.
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
adoCommand.CommandText = strQuery
adoCommand.Properties("Page Size") = 100
adoCommand.Properties("Timeout") = 30
adoCommand.Properties("Cache Results") = False

' Запрос синтаксиса.
Set adoRecordset = adoCommand.Execute

' Перебор результирующих записей.
Do Until adoRecordset.EOF
    ' Извлечение значений.
    strName = adoRecordset.Fields("sAMAccountName").Value
    strEmail = adoRecordset.Fields("mail").Value & ""
    arrEmails = adoRecordset.Fields("proxyAddresses").Value
    If (strEmail = "") And (IsNull(arrEmails) = False) Then
        ' Select primary email address.
        For Each strItem In arrEmails
            strPrefix = Left(strItem, 5)
            If (strPrefix = "SMTP:") Or (strPrefix = "X400:") Then
                strEmail = Mid(strItem, 6)
                Exit For
            End If
        Next
    End If
    ' Определение истечения срока действия пароля.
    ' Атрибут pwdLastSet всегда должен иметь присвоенное значение,
    ' но другие атрибуты Integer8 представления дат может быть "нулевым".
    If (TypeName(adoRecordset.Fields("pwdLastSet").Value) = "Object") Then
        Set objDate = adoRecordset.Fields("pwdLastSet").Value
        dtmPwdLastSet = Integer8Date(objDate, lngBias)
    Else
        dtmPwdLastSet = #1/1/1601#
    End If
    dtmExpires = DateAdd("d", sngMaxPwdAge, dtmPwdLastSet)
	dtmDaysLeft = DateDiff("d",FormatDateTime(Date,2),FormatDateTime(dtmExpires,2))
'wscript.echo strName,dtmExpires,dtmDaysLeft
	IF ((dtmDaysLeft = 7) OR (dtmDaysLeft = 5) OR (dtmDaysLeft = 3) OR (dtmDaysLeft = 1)) Then
    If (strEmail <> "") Then
'wscript.echo strName,dtmExpires,dtmDaysLeft	
        ' Send an email message to the user.
        Call SendEmailMessage(strEmail, objDomain.Get("name") & "\" & strName, dtmExpires, dtmDaysLeft)
'        Wscript.Echo "Message for " & strName & " sent to " & strEmail
    Else
'        Wscript.Echo "No email address for " & strName
    End If
	End If
    ' Move to the next record in the recordset.
    adoRecordset.MoveNext
Loop

' Clean up.
adoRecordset.Close
adoConnection.Close

Function Integer8Date(ByVal objDate, ByVal lngBias)
    ' Функция преобразования значения Integer8 (64-разрядное) в дату, скорректированная для смещение локального часового пояса.
    Dim lngAdjust, lngDate, lngHigh, lngLow
    lngAdjust = lngBias
    lngHigh = objDate.HighPart
    lngLow = objDate.LowPart
    ' Учетная запись для ошибки в методах свойства IADsLargeInteger.
    If (lngLow < 0) Then
        lngHigh = lngHigh + 1
    End If
    If (lngHigh = 0) And (lngLow = 0) Then
        lngAdjust = 0
    End If
    lngDate = #1/1/1601# + (((lngHigh * (2 ^ 32)) _
        + lngLow) / 600000000 - lngAdjust) / 1440
    ' Ошибка , если lngDate очень большой.
    On Error Resume Next
    Integer8Date = CDate(lngDate)
    If (Err.Number <> 0) Then
        On Error GoTo 0
        Integer8Date = #1/1/1601#
    End If
    On Error GoTo 0

End Function

Sub SendEmailMessage(ByVal strDestEmail, ByVal strNTName, ByVal dtmDate, ByVal dtmDaysLeft)
	' Отправить зерез порт 25 SMTP-сервера.
	Const cdoSendUsingPort = 2
 
dim iMsg, iConf,Flds,shtml 

	set iMsg = CreateObject("CDO.Message")
	set iConf = CreateObject("CDO.Configuration")
	
	Set Flds = iConf.Fields
 
	' Поля конфигурации для порта 25 на вашем SMTP-сервере
	With Flds
	    .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = cdoSendUsingPort
	    .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "192.168.30.50" 
	    .Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 10
	    .Update
	End With
	
	' HTML-код для текста сообщений.
if dtmDaysLeft = 1 then
	shtml ="<HTML>"
	shtml = shtml & "<H1><B><FONT face='Arial Rounded MT Bold' color=#FF0000 size=4>Последнее предупреждение об истечении срока действия пароля</FONT></B></H1>"
	shtml = shtml & "<P><FONT face=Arial size=2>Вы получили это письмо, потому что срок действия Вашего пароля для учётной записи <H1><B><FONT face='Arial Rounded MT Bold' color=#FF0000 size=4>" & strName & "</FONT></B></H1> истекает <H1><B><FONT face='Arial Rounded MT Bold' color=#FF0000 size=2>" & dtmDate & " (т.е. завтра!).</FONT></B></H1><br>"
	shtml = shtml & "Если пароль не будет сменён до указанного срока, доступ ко всем системам будет автоматически закрыт!<br><br>В случае блокировки Вашей учётной записи необходимо:<br>Обратиться в техподдержку по телефону 555<br>* Приятного рабочего дня</FONT></P>"
	shtml = shtml & "</BODY></HTML>"
else
	shtml ="<HTML>"
	shtml = shtml & "<H1><B><FONT face='Arial Rounded MT Bold' color=#e20074 size=4>Уведомление об истечении срока действия пароля</FONT></B></H1>"
	shtml = shtml & "<P><FONT face=Arial size=2>Вы получили это письмо, потому что срок действия Вашего пароля для учётной записи <H1><B><FONT face='Arial Rounded MT Bold' color=#e20074 size=2>" & strName & "</FONT></B></H1> истекает <H1><B><FONT face='Arial Rounded MT Bold' color=#e20074 size=2>" & dtmDate & ".</FONT></B></H1><br>"
	shtml = shtml & "Для предотвращения отказа в доступе, необходимо поменять пароль до окончания этого срока.</FONT></P>"
	shtml = shtml & "</BODY></HTML>"
end if	
 
	' Apply the settings to the message.
	With iMsg
	    Set .Configuration = iConf
	    .To = strDestEmail
            .Bcc = "KOPIYA@contora.ru"
	    .From = "OTKOGO@contora.ru"
		Select Case dtmDaysLeft
			Case 7
				.Subject = "Пароль для учётной записи " & strName & " истечёт " & dtmDate & " (через " & dtmDaysLeft & " дней)."
			Case 5
				.Subject = "Пароль для учётной записи " & strName & " истечёт " & dtmDate & " (через " & dtmDaysLeft & " дней)."
			Case 3
				.Subject = "Пароль для учётной записи " & strName & " истечёт " & dtmDate & " (через " & dtmDaysLeft & " дня)."
			Case 1
				.Subject = "Пароль для учётной записи " & strName & " истечёт " & dtmDate & " (через " & dtmDaysLeft & " день)."

				.Fields("urn:schemas:httpmail:Importance").Value = 2
				.Fields("urn:schemas:mailheader:importance").Value = "High"

				.Fields("urn:schemas:httpmail:priority").Value = 1
				.Fields("urn:schemas:mailheader:priority").Value = 1

				.Fields("urn:schemas:mailheader:X-MSMail-Priority").Value = "High"
				.Fields("urn:schemas:mailheader:X-Priority").Value = 1

				.Fields("urn:schemas:httpmail:X-MSMail-Priority").Value = "High"
				.Fields("urn:schemas:httpmail:X-Priority").Value = 1
				.Fields.update
		End Select
	    .HTMLBody = shtml		
'		.AddAttachment(sFolderPath & ZipFile)
	    .Send
	End With
 
 
	' Очистка переменных.
	Set iMsg = Nothing
	Set iConf = Nothing
	Set Flds = Nothing

End Sub

100

101

102

103

104

105

106

107

108

109

110

111

112

113

114

115

116

117

118

119

120

121

122

123

124

125

126

127

128

129

130

131

132

133

134

135

136

137

138

139

140

141

142

143

144

145

146

147

148

149

150

151

152

153

154

155

156

157

158

159

160

161

162

163

164

165

166

167

168

169

170

171

172

173

174

175

176

177

178

179

180

181

182

183

184

185

186

187

188

189

190

191

192

193

194

195

196

197

198

199

200

201

202

203

204

205

206

207

208

209

210

211

212

213

214

215

216

217

218

219

220

221

222

223

224

225

226

227

228

229

230

231

232

233

234

235

236

237

238

239

240

241

242

243

244

245

246

247

248

249

Option Explicit

Dim adoCommand, adoConnection, strBase, strFilter, strAttributes

Dim objRootDSE, strDNSDomain, strQuery, adoRecordset

Dim dtmDate1, dtmDate2, intDays, strName, strEmail, dtmDaysLeft

Dim lngSeconds1, str64Bit1, lngSeconds2, str64Bit2

Dim objShell, lngBiasKey, lngBias, k

Dim objDomain, objMaxPwdAge, lngHighAge, lngLowAge, sngMaxPwdAge

Dim objDate, dtmPwdLastSet, dtmExpires

Dim arrEmails, strItem, strPrefix

' Количество дней до истечения пароля

intDays = 7

' Определяем политику максимального срока действия пароля домена в днях.

Set objRootDSE = GetObject("LDAP://RootDSE")

strDNSDomain = objRootDSE.Get("DefaultNamingContext")

Set objDomain = GetObject("LDAP://" & strDNSDomain)

Set objMaxPwdAge = objDomain.MaxPwdAge

' Учетная запись для ошибки в методах свойства IADslargeIntege.

lngHighAge = objMaxPwdAge.HighPart

lngLowAge = objMaxPwdAge.LowPart

If (lngLowAge < 0) Then

lngHighAge = lngHighAge + 1

End If

' Преобразование из 100-наносекундных интервалов в дни.

sngMaxPwdAge = -((lngHighAge * 2^32) _

+ lngLowAge)/(600000000 * 1440)

' Определяем дату последнего изменения пароля,

' исключая пользователей, чей пароль уже истек.

dtmDate1 = DateAdd("d", - sngMaxPwdAge, Now())

' Определяем дату последнего изменения пароля,

' срок действия пароля истекал в будущем.

dtmDate2 = DateAdd("d", intDays - sngMaxPwdAge, Now())

' Получение смещения локального часового пояса от реестра компьютера..

Set objShell = CreateObject("Wscript.Shell")

lngBiasKey = objShell.RegRead("HKLM\System\CurrentControlSet\Control\" _

& "TimeZoneInformation\ActiveTimeBias")

If (UCase(TypeName(lngBiasKey)) = "LONG") Then

lngBias = lngBiasKey

ElseIf (UCase(TypeName(lngBiasKey)) = "VARIANT()") Then

lngBias = 0

For k = 0 To UBound(lngBiasKey)

lngBias = lngBias + (lngBiasKey(k) * 256^k)

End If

' Преобразования типа datetime в формате UTC.

dtmDate1 = DateAdd("n", lngBias, dtmDate1)

dtmDate2 = DateAdd("n", lngBias, dtmDate2)

' Поиск количества секунд, прошедших с 1/1/1601 на эти даты.

lngSeconds1 = DateDiff("s", #1/1/1601#, dtmDate1)

lngSeconds2 = DateDiff("s", #1/1/1601#, dtmDate2)

'Преобразовать количество секунд в строку

'и преобразовать в 100-наносекундных интервалы.

str64Bit1 = CStr(lngSeconds1) & "0000000"

str64Bit2 = CStr(lngSeconds2) & "0000000"

' Настройка объектов ADO.

Set adoCommand = CreateObject("ADODB.Command")

Set adoConnection = CreateObject("ADODB.Connection")

adoConnection.Provider = "ADsDSOObject"

adoConnection.Open "Active Directory Provider"

Set adoCommand.ActiveConnection = adoConnection

' Поиск по всему домену Active Directory.

strBase = "<LDAP://" & strDNSDomain & ">"

' Фильтр по объектам пользователей,

' срок действия которых истекает между,

' дата указана,

' учетная запись не отключена,

' пароль не имеет срок действия,

' пароль не требуется не установлено,

' и пароль не может быть изменен не установлен.

strFilter = "(&(objectCategory=person)(objectClass=user)" _

& "(pwdLastSet>=" & str64Bit1 & ")" _

& "(pwdLastSet<=" & str64Bit2 & ")" _

& "(!userAccountControl:1.2.840.113556.1.4.803:=2)" _

& "(!userAccountControl:1.2.840.113556.1.4.803:=65536)" _

& "(!userAccountControl:1.2.840.113556.1.4.803:=32)" _

& "(!userAccountControl:1.2.840.113556.1.4.803:=48))"

' Список значений атрибутов с разделителями-запятыми для отбора.

strAttributes = "sAMAccountName,mail,proxyAddresses,pwdLastSet"

' Построение синтаксиса запроса протокола LDAP.

strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"

adoCommand.CommandText = strQuery

adoCommand.Properties("Page Size") = 100

adoCommand.Properties("Timeout") = 30

adoCommand.Properties("Cache Results") = False

' Запрос синтаксиса.

Set adoRecordset = adoCommand.Execute

' Перебор результирующих записей.

Do Until adoRecordset.EOF

' Извлечение значений.

strName = adoRecordset.Fields("sAMAccountName").Value

strEmail = adoRecordset.Fields("mail").Value & ""

arrEmails = adoRecordset.Fields("proxyAddresses").Value

If (strEmail = "") And (IsNull(arrEmails) = False) Then

' Select primary email address.

For Each strItem In arrEmails

strPrefix = Left(strItem, 5)

If (strPrefix = "SMTP:") Or (strPrefix = "X400:") Then

strEmail = Mid(strItem, 6)

Exit For

End If

' Определение истечения срока действия пароля.

' Атрибут pwdLastSet всегда должен иметь присвоенное значение,

' но другие атрибуты Integer8 представления дат может быть "нулевым".

If (TypeName(adoRecordset.Fields("pwdLastSet").Value) = "Object") Then

Set objDate = adoRecordset.Fields("pwdLastSet").Value

dtmPwdLastSet = Integer8Date(objDate, lngBias)

Else

dtmPwdLastSet = #1/1/1601#

End If

dtmExpires = DateAdd("d", sngMaxPwdAge, dtmPwdLastSet)

dtmDaysLeft = DateDiff("d",FormatDateTime(Date,2),FormatDateTime(dtmExpires,2))

'wscript.echo strName,dtmExpires,dtmDaysLeft

IF ((dtmDaysLeft = 7) OR (dtmDaysLeft = 5) OR (dtmDaysLeft = 3) OR (dtmDaysLeft = 1)) Then

If (strEmail <> "") Then

'wscript.echo strName,dtmExpires,dtmDaysLeft

' Send an email message to the user.

Call SendEmailMessage(strEmail, objDomain.Get("name") & "\" & strName, dtmExpires, dtmDaysLeft)

' Wscript.Echo "Message for " & strName & " sent to " & strEmail

Else

' Wscript.Echo "No email address for " & strName

End If

' Move to the next record in the recordset.

adoRecordset.MoveNext

Loop

' Clean up.

adoRecordset.Close

adoConnection.Close

Function Integer8Date(ByVal objDate, ByVal lngBias)

' Функция преобразования значения Integer8 (64-разрядное) в дату, скорректированная для смещение локального часового пояса.

Dim lngAdjust, lngDate, lngHigh, lngLow

lngAdjust = lngBias

lngHigh = objDate.HighPart

lngLow = objDate.LowPart

' Учетная запись для ошибки в методах свойства IADsLargeInteger.

If (lngLow < 0) Then

lngHigh = lngHigh + 1

End If

If (lngHigh = 0) And (lngLow = 0) Then

lngAdjust = 0

End If

lngDate = #1/1/1601# + (((lngHigh * (2 ^ 32)) _

+ lngLow) / 600000000 - lngAdjust) / 1440

' Ошибка , если lngDate очень большой.

On Error Resume Next

Integer8Date = CDate(lngDate)

If (Err.Number <> 0) Then

On Error GoTo 0

Integer8Date = #1/1/1601#

End If

On Error GoTo 0

End Function

Sub SendEmailMessage(ByVal strDestEmail, ByVal strNTName, ByVal dtmDate, ByVal dtmDaysLeft)

' Отправить зерез порт 25 SMTP-сервера.

Const cdoSendUsingPort = 2

dim iMsg, iConf,Flds,shtml

set iMsg = CreateObject("CDO.Message")

set iConf = CreateObject("CDO.Configuration")

Set Flds = iConf.Fields

' Поля конфигурации для порта 25 на вашем SMTP-сервере

With Flds

.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = cdoSendUsingPort

.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "192.168.30.50"

.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 10

.Update

End With

' HTML-код для текста сообщений.

if dtmDaysLeft = 1 then

shtml ="<HTML>"

shtml = shtml & "<H1><B><FONT face='Arial Rounded MT Bold' color=#FF0000 size=4>Последнее предупреждение об истечении срока действия пароля</FONT></B></H1>"

shtml = shtml & "<P><FONT face=Arial size=2>Вы получили это письмо, потому что срок действия Вашего пароля для учётной записи <H1><B><FONT face='Arial Rounded MT Bold' color=#FF0000 size=4>" & strName & "</FONT></B></H1> истекает <H1><B><FONT face='Arial Rounded MT Bold' color=#FF0000 size=2>" & dtmDate & " (т.е. завтра!).</FONT></B></H1><br>"

shtml = shtml & "Если пароль не будет сменён до указанного срока, доступ ко всем системам будет автоматически закрыт!<br><br>В случае блокировки Вашей учётной записи необходимо:<br>Обратиться в техподдержку по телефону 555<br>* Приятного рабочего дня</FONT></P>"

shtml = shtml & "</BODY></HTML>"

else

shtml ="<HTML>"

shtml = shtml & "<H1><B><FONT face='Arial Rounded MT Bold' color=#e20074 size=4>Уведомление об истечении срока действия пароля</FONT></B></H1>"

shtml = shtml & "<P><FONT face=Arial size=2>Вы получили это письмо, потому что срок действия Вашего пароля для учётной записи <H1><B><FONT face='Arial Rounded MT Bold' color=#e20074 size=2>" & strName & "</FONT></B></H1> истекает <H1><B><FONT face='Arial Rounded MT Bold' color=#e20074 size=2>" & dtmDate & ".</FONT></B></H1><br>"

shtml = shtml & "Для предотвращения отказа в доступе, необходимо поменять пароль до окончания этого срока.</FONT></P>"

shtml = shtml & "</BODY></HTML>"

end if

' Apply the settings to the message.

With iMsg

Set .Configuration = iConf

.To = strDestEmail

.Bcc = "KOPIYA@contora.ru"

.From = "OTKOGO@contora.ru"

Select Case dtmDaysLeft

Case 7

.Subject = "Пароль для учётной записи " & strName & " истечёт " & dtmDate & " (через " & dtmDaysLeft & " дней)."

Case 5

.Subject = "Пароль для учётной записи " & strName & " истечёт " & dtmDate & " (через " & dtmDaysLeft & " дней)."

Case 3

.Subject = "Пароль для учётной записи " & strName & " истечёт " & dtmDate & " (через " & dtmDaysLeft & " дня)."

Case 1

.Subject = "Пароль для учётной записи " & strName & " истечёт " & dtmDate & " (через " & dtmDaysLeft & " день)."

.Fields("urn:schemas:httpmail:Importance").Value = 2

.Fields("urn:schemas:mailheader:importance").Value = "High"

.Fields("urn:schemas:httpmail:priority").Value = 1

.Fields("urn:schemas:mailheader:priority").Value = 1

.Fields("urn:schemas:mailheader:X-MSMail-Priority").Value = "High"

.Fields("urn:schemas:mailheader:X-Priority").Value = 1

.Fields("urn:schemas:httpmail:X-MSMail-Priority").Value = "High"

.Fields("urn:schemas:httpmail:X-Priority").Value = 1

.Fields.update

End Select

.HTMLBody = shtml

' .AddAttachment(sFolderPath & ZipFile)

.Send

End With

' Очистка переменных.

Set iMsg = Nothing

Set iConf = Nothing

Set Flds = Nothing

End Sub

Правим строки для своих настроек сети

От кого отправляется письмо, кто стоит в копии письма.

213-214

.Bcc = «KOPIYA@contora.ru»

.From = «OTKOGO@contora.ru»

Как выглядит обращение в сомам письме , ФИО, учётная запись , или как угодно. Атрибут — & strName &

216-223

Case 7

.Subject = «Пароль для учётной записи « & strName & » истечёт « & dtmDate & » (через « & dtmDaysLeft & » дней).»

Case 5

.Subject = «Пароль для учётной записи « & strName & » истечёт « & dtmDate & » (через « & dtmDaysLeft & » дней).»

Case 3

.Subject = «Пароль для учётной записи « & strName & » истечёт « & dtmDate & » (через « & dtmDaysLeft & » дня).»

Case 1

.Subject = «Пароль для учётной записи « & strName & » истечёт « & dtmDate & » (через « & dtmDaysLeft & » день).»

IP адрес вашего SMTP сервера для отправки писем.

189

.Item(«http://schemas.microsoft.com/cdo/configuration/smtpserver») = «192.168.30.50»

Копируем весь текст .

Создаём файл VBS и вставляем в него текст. Ставим данный файл в задание на почтовом сервере с запуском каждое утро в 9-00 .

Тестируем.

Считаю что данное детище, отличное воплощение по поставленной задаче: Оповещение пользователей о окончании срока пароля по почте.

Ленивые люди, двигатель прогресса.

Для более приятной картины письма, с фотографиями пользователей, рекомендую почитать статью Добавить фотографию пользователю Active directory

2 комментария

Ден

19.05.2020 в 20:11 (UTC 3) Ссылка на этот комментарий

Ответить

Странно что никто не оставил комментарий на эту статью. Если действительно все работает, это очень крутое решение. Спасибо заранее.
1. Woot
  
  20.05.2020 в 10:07 (UTC 3) Ссылка на этот комментарий
  
  Ответить
  
  Добрый день.
  На самом деле, всё что описано на сайте с начало сделано на боевых серверах, а уже потом выложено )
  Данную рассылку уже воплотили в 4 фирмах. Знакомы админы просят помощи. Я и не против отказать.
  
  Так что, рабочая штука. Можно брать на вооружение.
  
  И по статистике:
  народ начинает реагировать на данные письма через 2-3 месяца ) до это они думают что это не для них )))

turbo-blog.ru

Турбо блог

Оповещение пользователей о окончании срока пароля по почте

Единственный, полезный и реально рабочий механизм это: Оповещение пользователей о окончании срока пароля по почте.

Создаём задания на оповещение пользователей о окончании срока пароля.

Правим строки для своих настроек сети

От кого отправляется письмо, кто стоит в копии письма.

Как выглядит обращение в сомам письме , ФИО, учётная запись , или как угодно. Атрибут — & strName &

IP адрес вашего SMTP сервера для отправки писем.

2 комментария

Ден

Woot

Добавить комментарий Отменить ответ

Разделы статей

Свежие записи

Свежие комментарии

Copyright

turbo-blog.ru

Турбо блог

Оповещение пользователей о окончании срока пароля по почте

Единственный, полезный и реально рабочий механизм это: Оповещение пользователей о окончании срока пароля по почте.

Создаём задания на оповещение пользователей о окончании срока пароля.

Правим строки для своих настроек сети

От кого отправляется письмо, кто стоит в копии письма.

Как выглядит обращение в сомам письме , ФИО, учётная запись , или как угодно. Атрибут — & strName &

IP адрес вашего SMTP сервера для отправки писем.

2 комментария

Ден

Woot

Добавить комментарий Отменить ответ

Разделы статей

Свежие записи

Свежие комментарии

Метки

Copyright