Leer la libreta de contactos del Outlook y enviarles un correo a todos vía SMTP con autenticación

Descargar aplicación SendMailContactOutlook.zip

Excelente herramienta para enviar de forma masiva e individual correos a nuestros contactos del Outlook. Lo mas importante es que no utilizaremos en Outlook para enviar los mensajes, así no nos quedan los mensajes en el SentMail.

Cuando vamos Traer los Datos (Botón) de la libreta de direcciones al Outlook, este por su seguridad nos va a solicitar acceso con el siguiente mensaje

Luego de tener el acceso, se llena la lista con el nombre y el correo electrónico de nuestros contactos, donde podremos Seleccionar Todos (Link Label) o seleccionar solo los que deseamos.

Antes de poder enviar mensajes debemos Configurar (Botón) las cuentas de correo, donde le definimos todos los detalles como servidor SMTP, Nombre del Correo, Correo Electrónico, Usuario y Contraseña, todos estos datos son para la autenticación del SMTP server.

Aquí podremos agregar tantas cuentas como necesitemos, y a estas las podremos modificar o eliminar según sea el caso.

El siguiente paso seria definir el correo que vamos a enviar, donde hemos tomado el código de una publicación anterior, el cual nos sirve a la perfectamente para esta aplicación.

Le definimos los datos propios de un mensaje, Subject, Archivos, Formato, Contenido y le indicamos Enviar (Botón).

Para poder leer los Contactos del Outlook vamos a utilizar la librería Microsoft.Office.Interop.Outlook.dll que nos brinda Microsoft, utilizando el siguiente código.

'Trae los contactos que se encuentren en la libreta de direcciones del Outlook
Private Sub btnTraerContactos_Click(ByVal sender As System.Object, _
ByVal e As System.EventArgs) Handles btnTraerContactos.Click
Try
Dim iContact As Outlook.ContactItem

Dim iFolder As Outlook.MAPIFolder
Dim iNameSpace As Outlook.NameSpace
Dim iOutlook As New Outlook.ApplicationClass

iNameSpace = iOutlook.GetNamespace(«MAPI»)

iFolder = iNameSpace.GetDefaultFolder(Outlook.OlDefaultFolders.olFolderContacts)

Me.lvContactos.Items.Clear()
For Each iContact In iFolder.Items
Dim itm As New ListViewItem
itm.Text = iContact.FirstName
itm.SubItems.Add(iContact.LastName)
If Not IsNothing(iContact.Email1Address) Then
If iContact.Email1Address.Trim.Length > 0 Then
itm.SubItems.Add(iContact.Email1Address)
Me.lvContactos.Items.Add(itm)
End If
End If
Next
Me.sbDetalles.Panels(0).Text = «Contactos: » & Me.lvContactos.Items.Count
Catch ex As Exception
MsgBox(ex.Message, MsgBoxStyle.Critical, «Envío de correos»)
End Try
End Sub

Como podemos ver en el código solicitamos el folder correspondiente a los contactos GetDefaultFolder(Outlook.OlDefaultFolders.olFolderContacts), pero perfectamente podrias hacer otra aplicación solicitando otro folder del Outlook, por ejemplo

– Calendario: Outlook.OlDefaultFolders.olFolderCalendar
– Contactos: Outlook.OlDefaultFolders.olFolderContacts
– Mensajes eliminados: Outlook.OlDefaultFolders.olFolderDeletedItems
– Inbox: Outlook.OlDefaultFolders.olFolderInbox
– Notas: Outlook.OlDefaultFolders.olFolderNotes
– Mensajes enviados: Outlook.OlDefaultFolders.olFolderSentMail
– Task: Outlook.OlDefaultFolders.olFolderTasks

Para guardar nuestra configuración de cuentas de correos, vamos a almacenarlos en un arxhivo xml que se va a grabar en la misma ruta donde se encuentre el ejecutable de la aplicación.

Private Sub AlmacenarInformacion()
Try
Dim dt As New DataTable
dt.Columns.Add(New DataColumn(«Smtp», GetType(String)))
dt.Columns.Add(New DataColumn(«Correo», GetType(String)))
dt.Columns.Add(New DataColumn(«Nombre», GetType(String)))
dt.Columns.Add(New DataColumn(«Usuario», GetType(String)))
dt.Columns.Add(New DataColumn(«Clave», GetType(String)))

Dim dsDatos As New DataSet

If File.Exists(«dsSMOC.xml») Then
dsDatos.ReadXml(«dsSMOC.xml»)
End If

If dsDatos.Tables.Count > 0 Then
If dsDatos.Tables(0).Rows.Count > 0 Then
Dim drDatos As DataRow
Dim dr As DataRow
For Each drDatos In dsDatos.Tables(0).Rows
dr = dt.NewRow()
If drDatos(«Correo») <> Me.txtCorreo.Text And Me.txtCorreo.Text.Trim.Length > 0 Then
Dim drNuevo As DataRow
drNuevo = dt.NewRow()
drNuevo(«Smtp») = Me.txtSmtp.Text
drNuevo(«Correo») = Me.txtCorreo.Text
drNuevo(«Nombre») = Me.txtNombre.Text
drNuevo(«Usuario») = Me.txtUsuario.Text
drNuevo(«Clave») = Me.txtClave.Text
dt.Rows.Add(drNuevo)
Me.LimpiarCampos()
End If

dr(«Smtp») = drDatos(«Smtp»)
dr(«Correo») = drDatos(«Correo»)
dr(«Nombre») = drDatos(«Nombre»)
dr(«Usuario») = drDatos(«Usuario»)
dr(«Clave») = drDatos(«Clave»)
dt.Rows.Add(dr)
Next
End br>
Else
Dim dr As DataRow
dr = dt.Newow
dr(«Smtp») = Me.txtSmtp.Text
dr(«Correo») = Me.txtCorreo.Text
dr(«Nombre») = Me.txtNombre.Text
dr(«Usuario») = Me.txtUsuario.Text
dr(«Clave») = Me.txtClave.Text
dt.Rows.Add(dr)
Me.LimpiarCampos()
End If