none
Texto en color RRS feed

  • Pregunta

  • Buenos dias: La inquietud que tengo es que tengo un script que lo que hace es enviar por mail a los usuarios de OWA el aviso de caducidad de la contraseña, lo que necesitaria es que el mensaje del cuerpo sea en color Rojo y si se puede el asunto mucho mejor. adjunto que script.

     


    Option Explicit

    Dim objCommand, objConnection, objChild, objUserConnection, strBase, strFilter, strAttributes, strPasswordChangeDate, intPassAge
    Dim lngTZBias, objPwdLastSet, strEmailAddress, objMessage
    Dim objShell, lngBiasKey, k, PasswordExpiry, strRootDomain
    Dim strQuery, objRecordset, strName, strCN

    ' ********************* CHANGE THESE VALUES TO PASSWORD EXPIRY AND ROOT OF WHERE USERS WILL BE SEARCHED ***********************************

    PasswordExpiry=60
    strRootDomain="ou=usuarios,ou=Office-ar,dc=prog,dc=corp"

    ' *****************************************************************************************************************************************


    ' Obtain local Time Zone bias from machine registry.
    Set objShell = CreateObject("Wscript.Shell")
    lngBiasKey = objShell.RegRead("HKLM\System\CurrentControlSet\Control\TimeZoneInformation\ActiveTimeBias")
    If UCase(TypeName(lngBiasKey)) = "LONG" Then
      lngTZBias = lngBiasKey
    ElseIf UCase(TypeName(lngBiasKey)) = "VARIANT()" Then
      lngTZBias = 0
      For k = 0 To UBound(lngBiasKey)
        lngTZBias = lngTZBias + (lngBiasKey(k) * 256^k)
      Next
    End If

    Set objCommand = CreateObject("ADODB.Command")
    Set objConnection = CreateObject("ADODB.Connection")
    objConnection.Provider = "ADsDSOObject"
    objConnection.Open "Active Directory Provider"
    objCommand.ActiveConnection = objConnection
    strBase = "<LDAP://" & strRootDomain & ">"

    strFilter = "(&(objectCategory=person)(objectClass=user)(!userAccountControl:1.2.840.113556.1.4.803:=65536)(!userAccountControl:1.2.840.113556.1.4.803:=2))"
    strAttributes = "sAMAccountName,cn,mail,pwdLastSet,distinguishedName"
    strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
    objCommand.CommandText = strQuery
    objCommand.Properties("Page Size") = 100
    objCommand.Properties("Timeout") = 30
    objCommand.Properties("Cache Results") = False
    Set objRecordSet = objCommand.Execute

    ' WScript.echo "Running at " & Date()

    Do Until objRecordSet.EOF
      strName = objRecordSet.Fields("sAMAccountName").Value
      strCN = objRecordSet.Fields("cn").value
      strEmailAddress = objRecordSet.Fields("mail").value
      Wscript.Echo "NT Name: " & strName & ", Common Name: " & strCN

      Set objUserConnection = GetObject("LDAP://" & objRecordSet.Fields("distinguishedName").Value)
      Set objPwdLastSet = objUserConnection.pwdLastSet
      strPasswordChangeDate = Integer8Date(objPwdLastSet, lngTZBias)
      WScript.Echo vbTab & "Password last changed at " & strPasswordChangeDate
      intPassAge = DateDiff("d", strPasswordChangeDate, Now)
      WScript.Echo vbTab & "Password changed " & intPassAge & " days ago"

      If intPassAge = (PasswordExpiry-2) Then
        WScript.echo vbTab & "Sending user notification to " & strEmailAddress & " that password expires in 2 days"
        Call SendEmailMessage(strEmailAddress, 2)
      ElseIf intPassAge = (PasswordExpiry-4) Then
        WScript.echo vbTab & "Sending user notification to " & strEmailAddress & " that password expires in 4 days"
        Call SendEmailMessage(strEmailAddress, 4)
      ElseIf intPassAge = (PasswordExpiry-7) Then
        WScript.echo vbTab & "Sending user notification to " & strEmailAddress & " that password expires in 7 days"
        Call SendEmailMessage(strEmailAddress, 7)
      ElseIf intPassAge = (PasswordExpiry-15) Then
        WScript.echo vbTab & "Sending user notification to " & strEmailAddress & " that password expires in 15 days"
        Call SendEmailMessage(strEmailAddress, 15)
      End If

      objRecordSet.MoveNext
    Loop

    objConnection.Close


    Function Integer8Date(objDate, lngBias)
    ' Function to convert Integer8 (64-bit) value to a date, adjusted for
    ' local time zone bias.
      Dim lngAdjust, lngDate, lngHigh, lngLow
      lngAdjust = lngBias
      lngHigh = objDate.HighPart
      lngLow = objdate.LowPart
      ' Account for error in IADslargeInteger property methods.
      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
    ' Trap error if lngDate is overly large
      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(strDestEmail, strNoOfDays)
      Set objMessage = CreateObject("CDO.Message")
      objMessage.Subject = "Password Expires in " & strNoOfDays & " days"
      objMessage.Sender = "soporte-it@prog.com"
      objMessage.To = strDestEmail
      objMessage.TextBody = "Your password expires in " & strNoOfDays & " days. Please go to https://mail.prog.com/exchange and reset"
      objMessage.Send
    End Sub


    Adrian Rodriguez -
    martes, 8 de junio de 2010 12:35

Respuestas

  • Para hacer lo que quieres, es necesario que el mensaje lo envíes en formato HTML, pues el texto plano no puede ser marcado, es decir, no puede cambiar de color. En lugar de establecer el contenido del mensaje con la propiedad TextBody del objeto CDO.Message, debes usar la propiedad HTMLBody y pasarle el marcado HTML que te interese:

    Sub SendEmailMessage(strDestEmail, strNoOfDays)
     Set objMessage = CreateObject("CDO.Message")
     objMessage.Subject = "Password Expires in " & strNoOfDays & " days"
     objMessage.Sender = "soporte-it@prog.com"
     objMessage.To = strDestEmail
     objMessage.HTMLBody = "<span style=""color: #FF0000"">Your " & _
                "password expires in " & strNoOfDays & _
                " days.</span> Please go to <a href=" & _
                """https://mail.prog.com/exchange"">" & _
                "https://mail.prog.com/exchange</a> and reset"
     objMessage.Send
    End Sub

    Respecto al color del asunto, eso no lo puedes cambiar. Todo lo más, puedes cambiar la importancia al mensaje, pero eso te complica un poco, pues debes usar un objeto CDO.Configuration y aplicarselo al objeto CDO.Message:

    Sub SendEmailMessage(strDestEmail, strNoOfDays)
    
     'Constantes de prioridad e importancia
     Const cdoPriorityNonUrgent = -1 'Prioridad: No Urgente
     Const cdoPriorityNormal = 0   'Prioridad: Normal
     Const cdoPriorityUrgent = 1   'Prioridad: Urgente
     Const cdoLow = 0        'Importancia: Baja
     Const cdoNormal = 1       'Importancia: Normal
     Const cdoHigh = 2        'Importancia: Alta
    
     'Constantes de tipo de autenticación
     Const cdoAnonymous = 0     'Sin autenticación
     Const cdoBasic = 1       'Texto plano
     Const cdoNTLM = 2        'Autenticación NTLM
    
     'Constantes de tipo de SMTP
     Const cdoSendÇUsingPickup = 1  'Servidor SMTP local
     Const cdoSendUsingPort = 2   'Servidor SMTP en la red
    
    
    
     'Creamos los objetos mensaje y configuración
     Set objConf = CreateObject("CDO.Configuration")
     Set objMessage = CreateObject("CDO.Message")
    
     'Por comodidad, creamos una variable con la URL de configuración
     strConf = "http://schemas.microsoft.com/cdo/configuration/"
    
     'Establecemos el tipo de envío
     objConf.Fields.Item(strConf & "sendusing") = 2
     'Establecemos el servidor SMTP
     objConf.Fields.Item(strConf & "smtpserver") = "tusmtp.prog.com"
     'Establecemos el puerto TCP del servidor
     objConf.Fields.Item(strConf & "smtpserverport") = 25
     'Establecemos el tipo de autenticación como anónima
     objConf.Fields.Item(strConf & "smtpauthenticate") = 0
     'Actualizamos la configuración
     objConf.Fields.Update
     
     'Para envío con Outlook
     objConf.Fields.Item(cdoImportance) = cdoHigh
     objConf.Fields.Item(cdoPriority) = cdoPriorityUrgent
    
     'Para Envío con Outlook Express
     objConf.Fields.Item("urn:schemas:mailheader:X-Priority") = cdoPriorityUrgent
    
     'Actualizamos la configuración
     objConf.Fields.Update
    
     'Establecemos la configuración del mensaje
     Set objMessage.Configuration = objConf
    
     'Establecemos el asunto
     objMessage.Subject = "Password Expires in " & strNoOfDays & " days"
     'Establecemos el remitente
     objMessage.Sender = "soporte-it@prog.com"
     'Establecemos el destinatario
     objMessage.To = strDestEmail
     'Establecemos el cuerpo HTML del mensaje
     objMessage.HTMLBody = "<span style=""color: #FF0000"">Your " & _
                "password expires in " & strNoOfDays & _
                " days.</span> Please go to <a href=" & _
                """https://mail.prog.com/exchange"">" & _
                "https://mail.prog.com/exchange</a> and reset"
     'Enviamos el mensaje
     objMessage.Send
    End Sub

    Un saludo

    Fernando Reyes [MS MVP]
    MCSA 2000/2003
    MCSE 2000/2003
    MCITP EnterpriseAdministrator
    Web: http://freyes.svetlian.com
    Blog: http://urpiano.wordpress.com
    RSS: http://urpiano.wordpress.com/feed/
    freyes.champú@champú.mvps.org
    (Aclárate la cabeza si quieres escribirme)
    martes, 8 de junio de 2010 15:56
    Moderador