En seguimiento a la solicitud en el comentario del artículo redactamos el siguiente articulo.
El Script solicitado es para Reenviar un correo entrante a un listado de contactos o Lista de distribución en CCO (Copia Oculta) este al momento que recibimos un correo reenvía el mensaje a un listado de contactos previamente establecida.
Instrucciones de Uso
1.- Abrir el editor de Visual Basic (ALT+F11).
2.- Insertar un modulo nuevo (Insert > Module).
3.- Copiar el código VBScript.
4.- En la linea 11 debemos especificar el campo Para: el cual es obligatorio para enviar un correo requerimos agregar un contacto como mínimo (Puede ser nuestro correo).
5.- En la linea 12 cambiamos TestList por el nombre de nuestra lista de distribución.
6.- Guardamos.
7.- Para finalizar creamos la regla que cumpla las condiciones de los correos a reenviar.
Para mas información de configuración ver: Como utilizar el Editor VBA en Office (Utilizar Macros VBScript) y Outlook – Crear y configurar reglas
Código
Sub FwdToDistList(msg As MailItem) ' hooked to Rule
Dim msgFwd As Outlook.MailItem
Dim objBCCRecips As Recipient
Dim intC As Integer
Set msgFwd = msg.Copy ' Crea copia a reenviar
With msgFwd
For intC = .Recipients.Count To 1 Step -1
.Recipients.Remove intC ' Remieve los remitentes actuales
Next intC
.Recipients.Add "contacto@portalmastips.com" ' set the TO: line addressee, must be at least one
Set objBCCRecips = .Recipients.Add("TestList") ' add the Distribution List
objBCCRecips.Resolve ' check that the Distribution List is valid
If objBCCRecips.Resolved Then
objBCCRecips.Type = olBCC ' set it as BCC
Else
MsgBox objBCCRecips.Name & "No se ha encontrado al intentar reenviar " & msgFwd.Subject, , vbCritical + vbOKOnly ' pop a message if Dist List not found
GoTo CLEANUP: ' Dist List name not valid, or there's another problem with it, end the sub without further action
End If
If msgFwd.BodyFormat = olFormatHTML Then
.Subject = .Subject & " - " ' HTML paragraph break
Else
.Subject = .Subject & vbCrLf & vbCrLf ' standard line break
End If
.Subject = .Subject & "Reenviado por PortalMasTips"
.Save
.Send
End With
CLEANUP:
Set objBCCRecips = Nothing
Set msgFwd = Nothing
End Sub
