Imports Microsoft.Office.Interop Imports Microsoft.Office.Interop.Outlook 'Imports Microsoft.Office Imports System Public Class OUTLOOK #Region "VARIABLES PÚBLICAS" Public L_Mensajes As List(Of Mensaje) #End Region #Region "VARIABLES PRIVADAS" Private AppOutlook As Microsoft.Office.Interop.Outlook.Application Private oSesion As Microsoft.Office.Interop.Outlook.NameSpace Private oCarpetaRaiz As Microsoft.Office.Interop.Outlook.MAPIFolder Private oBandejaEntrada As Microsoft.Office.Interop.Outlook.MAPIFolder Private cl_Mensaje As Mensaje Private oMensajes As Microsoft.Office.Interop.Outlook.Items Private oMensaje As Microsoft.Office.Interop.Outlook.MailItem Private Arr_Remitentes() As String, Arr_Destinatarios() As String Private oMail As Microsoft.Office.Interop.Outlook.MailItem Private oRemitente As Microsoft.Office.Interop.Outlook.Recipient Private oDestinatarios As Microsoft.Office.Interop.Outlook.Recipients Private oDestinatario As Microsoft.Office.Interop.Outlook.Recipient 'Private AppOutlook As Outlook.Application, oSesion As Outlook.NameSpace 'Private oCuentas As Outlook.Accounts, oCuenta As Outlook.Account, oMail As Outlook.MailItem 'Private oCuentas As Microsoft.Office.Interop.Outlook.Accounts 'Private oCuenta As Microsoft.Office.Interop.Outlook.Account 'Private oCarpeta As Microsoft.Office.Interop.Outlook.MAPIFolder 'Private oCarpeta2 As Microsoft.Office.Interop.Outlook.MAPIFolder #End Region Public Sub New() _sError = "" AppOutlook = New Microsoft.Office.Interop.Outlook.Application oSesion = AppOutlook.GetNamespace("MAPI") _sVersion_Outlook = CStr(AppOutlook.Version) _iVersion_Outlook = Left(AppOutlook.Version, 2) '** ? Silenciar Alertas End Sub #Region "PROPIEDADES" Private _sError As String Public Property sError() As String Get Return _sError End Get Set(ByVal value As String) _sError = value End Set End Property Private _sVersion_Outlook As String Public Property sVersion_Outlook() As String Get Return _sVersion_Outlook End Get Set(ByVal value As String) _sVersion_Outlook = value End Set End Property Private _iVersion_Outlook As Integer Public Property iVersion_Outlook() As Integer Get Return _iVersion_Outlook End Get Set(ByVal value As Integer) _iVersion_Outlook = value End Set End Property Private _sCarpetaRaiz As String Public Property sCarpetaRaiz() As String Get Return _sCarpetaRaiz End Get Set(ByVal value As String) _sCarpetaRaiz = value End Set End Property Private _sBandejaEntrada As String Public Property sBandejaEntrada() As String Get Return _sBandejaEntrada End Get Set(ByVal value As String) _sBandejaEntrada = value End Set End Property Private _Filtro_Remite As String Public Property Filtro_Remite() As String Get Return _Filtro_Remite End Get Set(ByVal value As String) _Filtro_Remite = value End Set End Property Private _bFiltro_Remite_Exacto As Boolean Public Property bFiltro_Remite_Exacto() As Boolean Get Return _bFiltro_Remite_Exacto End Get Set(ByVal value As Boolean) _bFiltro_Remite_Exacto = value End Set End Property Private _Filtro_Asunto As String Public Property Filtro_Asunto() As String Get Return _Filtro_Asunto End Get Set(ByVal value As String) _Filtro_Asunto = value End Set End Property Private _bFiltro_Asunto_Exacto As Boolean Public Property bFiltro_Asunto_Exacto() As Boolean Get Return _bFiltro_Asunto_Exacto End Get Set(ByVal value As Boolean) _bFiltro_Asunto_Exacto = value End Set End Property #End Region #Region "METODOS PÚBLICOS" Public Sub LeerCorreo() Dim iMensajes As Integer Dim bFiltrado As Boolean oMensajes = oBandejaEntrada.Items oMensajes.Sort("[ReceivedTime]", True) L_Mensajes = New List(Of Mensaje) For iMensajes = 1 To oMensajes.Count cl_Mensaje = New Mensaje cl_Mensaje.iMensaje = iMensajes Try oMensaje = oMensajes.Item(iMensajes) bFiltrado = CumpleFiltro() If bFiltrado Then With cl_Mensaje If _iVersion_Outlook > 13 Then .IdOutlook = oMensaje.ConversationID .ObjMensaje = oMensaje .Remite_Nombre = oMensaje.SenderName .Remite_eMail = oMensaje.SenderEmailAddress .Asunto = oMensaje.Subject .Fecha_Recibido = oMensaje.ReceivedTime .Cuerpo = oMensaje.Body .nAdjuntos = oMensaje.Attachments.Count End With End If Catch ex As System.Exception cl_Mensaje.sError = "ERROR AL LEER EL MENSAJE" & vbCrLf & ex.Message ' MsgBox(cl_Mensaje.sError) End Try If bFiltrado Then L_Mensajes.Add(cl_Mensaje) 'Console.WriteLine("MENSAJE : " & iMensajes) 'Console.WriteLine("REMITENTE : " & oMensaje.SenderName) 'Console.WriteLine("ASUNTO : " & oMensaje.Subject) 'Console.WriteLine("FECHA : " & oMensaje.ReceivedTime) ''Console.WriteLine("CUERPO : " & Mensaje.Body) 'Console.WriteLine(vbCrLf & "*************************************************************" & vbCrLf) Next End Sub Public Sub EnviaMail(StrRemite As String, StrDestinatarios As String, StrAsunto As String, StrCuerpo As String, bHTML As Boolean) Dim sDest As String Try oMail = AppOutlook.CreateItem(Microsoft.Office.Interop.Outlook.OlItemType.olMailItem) oMail.Subject = StrAsunto oMail.Body = StrCuerpo Arr_Remitentes = Split(StrRemite, ";") Arr_Destinatarios = Split(StrDestinatarios, ";") oRemitente = AppOutlook.GetNamespace("MAPI").CreateRecipient(StrRemite) oRemitente.Resolve() oMail.ReplyRecipients.Add(StrRemite) oDestinatarios = oMail.Recipients For Each sDest In Arr_Destinatarios oDestinatario = oDestinatarios.Add(sDest) oDestinatario.Resolve() Next If (oDestinatario.Resolved) Then oMail.Send() Else _sError = "La Dirección del Destinatario es Incorrecta" End If Catch ex As System.Exception _sError = "Error al Enviar el Mensaje" End Try End Sub Public Function InicializaCarpetas() As Boolean Dim iCarp As Integer, iCarp2 As Integer For iCarp = 1 To oSesion.Folders.Count If oSesion.Folders(iCarp).Name = _sCarpetaRaiz Then oCarpetaRaiz = oSesion.Folders(iCarp) For iCarp2 = 1 To oCarpetaRaiz.Folders.Count If oCarpetaRaiz.Folders(iCarp2).Name = _sBandejaEntrada Then oBandejaEntrada = oCarpetaRaiz.Folders(iCarp2) Return True End If Next End If Next Return False End Function 'Public Sub Conectar() ' Dim iMensajes As Integer ' BandejaEntrada = oSesion.Folders.Item(1).Folders.Item("Bandeja de entrada") ' oMensajes = BandejaEntrada.Items ' For iMensajes = 1 To oMensajes.Count ' oMensaje = oMensajes.Item(iMensajes) ' Console.WriteLine("MENSAJE : " & iMensajes) ' Console.WriteLine("REMITENTE : " & oMensaje.SenderName) ' Console.WriteLine("ASUNTO : " & oMensaje.Subject) ' Console.WriteLine("FECHA : " & oMensaje.ReceivedTime) ' 'Console.WriteLine("CUERPO : " & Mensaje.Body) ' Console.WriteLine(vbCrLf & "*************************************************************" & vbCrLf) ' Next ' 'For Each mailboxFolder As MAPIFolder In oSesion.Folders ' ' Console.WriteLine("*******************>>" & mailboxFolder.Name) ' ' For Each inboxFolder As MAPIFolder In mailboxFolder.Folders ' ' Console.WriteLine(inboxFolder.Name) ' ' Next ' 'Next 'End Sub #End Region #Region "METODOS PRIVADOS" Private Function CumpleFiltro() As Boolean Dim bCumple As Boolean = True If _Filtro_Asunto <> "" Then If bFiltro_Asunto_Exacto Then If Not Trim(UCase(_Filtro_Asunto)) = Trim(UCase(oMensaje.Subject)) Then bCumple = False Else If InStr(1, Trim(UCase(oMensaje.Subject)), Trim(UCase(_Filtro_Asunto))) = 0 Then bCumple = False End If End If If Not bCumple Then Return bCumple If _Filtro_Remite <> "" Then If bFiltro_Remite_Exacto Then If Not Trim(UCase(_Filtro_Remite)) = Trim(UCase(oMensaje.SenderName)) Then bCumple = False Else If InStr(1, Trim(UCase(oMensaje.SenderName)), Trim(UCase(_Filtro_Remite))) = 0 Then bCumple = False End If End If Return bCumple End Function #End Region '************************************* CLASE MENSAJE ******************************************************* Public Class Mensaje #Region "VARIABLES PÚBLICAS" Public L_Adjuntos As List(Of Adjunto) #End Region #Region "VARIABLES PRIVADAS" Private obAdjunto As Microsoft.Office.Interop.Outlook.Attachment Private cl_Adjunto As Adjunto #End Region #Region "PROPIEDADES" '************************************************************************* '******************* PROPIEDADES ***************************************** '************************************************************************* Private _IdOutlook As String Public Property IdOutlook() As String Get Return _IdOutlook End Get Set(ByVal value As String) _IdOutlook = value End Set End Property Private _ObjMensaje As Microsoft.Office.Interop.Outlook.MailItem Public Property ObjMensaje() As Microsoft.Office.Interop.Outlook.MailItem Get Return _ObjMensaje End Get Set(ByVal value As Microsoft.Office.Interop.Outlook.MailItem) _ObjMensaje = value End Set End Property Private _iMensaje As Integer Public Property iMensaje() As Integer Get Return _iMensaje End Get Set(ByVal value As Integer) _iMensaje = value End Set End Property Private _sError As String Public Property sError() As String Get Return _sError End Get Set(ByVal value As String) _sError = value End Set End Property Private _Remite_Nombre As String Public Property Remite_Nombre() As String Get Return _Remite_Nombre End Get Set(ByVal value As String) _Remite_Nombre = value End Set End Property Private _Remite_eMail As String Public Property Remite_eMail() As String Get Return _Remite_eMail End Get Set(ByVal value As String) _Remite_eMail = value End Set End Property Private _Asunto As String Public Property Asunto() As String Get Return _Asunto End Get Set(ByVal value As String) _Asunto = value End Set End Property Private _Fecha_Recibido As Date Public Property Fecha_Recibido() As Date Get Return _Fecha_Recibido End Get Set(ByVal value As Date) _Fecha_Recibido = value End Set End Property Private _Cuerpo As String Public Property Cuerpo() As String Get Return _Cuerpo End Get Set(ByVal value As String) _Cuerpo = value End Set End Property Private _nAdjuntos As Integer Public Property nAdjuntos() As Integer Get Return _nAdjuntos End Get Set(ByVal value As Integer) _nAdjuntos = value If _nAdjuntos > 0 Then Call CargaAdjuntos() End If End Set End Property #End Region #Region "METODOS PÚBLICOS" Public Sub New() _sError = "" End Sub Public Function ExtraerAdjunto(RutaDestino As String, NomFichero As String, Optional bExacto As Boolean = False) As Boolean On Error GoTo TrataError For i As Integer = 0 To Me.L_Adjuntos.Count - 1 If bExacto Then If Me.L_Adjuntos(i).Fichero = NomFichero Then Me.L_Adjuntos(i).oAdjunto.SaveAsFile(RutaDestino & Me.L_Adjuntos(i).Fichero) Return True End If Else If InStr(1, Me.L_Adjuntos(i).Fichero, NomFichero) > 0 Then Me.L_Adjuntos(i).oAdjunto.SaveAsFile(RutaDestino & Me.L_Adjuntos(i).Fichero) Return True End If End If Next _sError = "OUTLOOK.ExtraerAdjunto() : No se Encuentra el Archivo Adjunto (" & NomFichero & ")" : Return False Exit Function TrataError: _sError = "OUTLOOK.ExtraerAdjunto() : " & Err.Description : Return False End Function #End Region #Region "METODOS PRIVADOS" Private Sub CargaAdjuntos() L_Adjuntos = New List(Of Adjunto) For i As Integer = 1 To _nAdjuntos obAdjunto = Me.ObjMensaje.Attachments.Item(i) cl_Adjunto = New Adjunto cl_Adjunto.iAdjunto = i Try With cl_Adjunto .Fichero = obAdjunto.FileName .Tamanno = obAdjunto.Size .oAdjunto = obAdjunto End With Catch ex As System.Exception cl_Adjunto.sError = "ERROR AL COMPROBAR EL ADJUNTO" & vbCrLf & ex.Message End Try L_Adjuntos.Add(cl_Adjunto) Next obAdjunto = Nothing End Sub #End Region End Class '************************************* CLASE ADJUNTO ******************************************************* Public Class Adjunto #Region "PROPIEDADES" Private _oAdjunto As Microsoft.Office.Interop.Outlook.Attachment Public Property oAdjunto() As Microsoft.Office.Interop.Outlook.Attachment Get Return _oAdjunto End Get Set(ByVal value As Microsoft.Office.Interop.Outlook.Attachment) _oAdjunto = value End Set End Property Private _iAdjunto As Integer Public Property iAdjunto() As Integer Get Return _iAdjunto End Get Set(ByVal value As Integer) _iAdjunto = value End Set End Property Private _sError As String Public Property sError() As String Get Return _sError End Get Set(ByVal value As String) _sError = value End Set End Property Private _Fichero As String Public Property Fichero() As String Get Return _Fichero End Get Set(ByVal value As String) _Fichero = value End Set End Property Private _Tamanno As Integer Public Property Tamanno() As Integer Get Return _Tamanno End Get Set(ByVal value As Integer) _Tamanno = value End Set End Property #End Region End Class End Class