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
Comments