Excel - Se creen expertos en VBA de Excel? Lean esto.

Option Compare Database

Dim myOlapp As New Outlook.Application

Dim myNameSpace As Outlook.NameSpace

Dim myFolder As Outlook.Folder

Dim iTotCorreos As Long

Dim myItem As Outlook.MailItem

Dim nItem As Long

Dim sCriterio As String ' el criterio para el filtro

Dim oItems As Outlook.Items

Dim sRemitente As String

'------------------------------------------------------------------------------------------------------------------------------

Private Sub btnCorreoAnterior_Click()

    Set myItem = oItems.GetPrevious

    subMuestraDatos

End Sub

'------------------------------------------------------------------------------------------------------------------------------

Private Sub btnCorreoPrimero_Click()

    nItem = 1

        Set myItem = oItems.GetFirst

        subMuestraDatos

End Sub

'------------------------------------------------------------------------------------------------------------------------------

Private Sub btnCorreoUltimo_Click()

        nItem = iTotCorreos

        Set myItem = oItems.GetLast

        subMuestraDatos

End Sub

'------------------------------------------------------------------------------------------------------------------------------

Private Sub btnSiguiente_Click()

    Set myItem = oItems.GetNext

    subMuestraDatos

End Sub

'------------------------------------------------------------------------------------------------------------------------------

Private Sub Form_Load()

sRemitente = "deneg_nhj@yahoo.com"

'iTotCorreos = myFolder.Items.Count - 1

    Set myOlapp = CreateObject("outlook.application")

    Set myNameSpace = myOlapp.GetNamespace("MAPI")

    Set myFolder = myNameSpace.GetDefaultFolder(olFolderInbox)

    sCriterio = "[SenderEmailAddress] =  " & sRemitente

     Set oItems = myFolder.Items.Restrict(sCriterio)

     oItems.Sort "[LastModificationTime]", True

        'Set myItem = myFolder.Items(1)

        'iTotCorreos = myFolder.Items.Count

        'myItem.BodyFormat = olFormatHTML

        Set myItem = oItems.GetFirst

        iTotCorreos = oItems.Count

        myItem.BodyFormat = olFormatHTML

    subMuestraDatos

    If IsLoaded("frmMenuPrincipal") Then

        Forms!frmMenuPrincipal.Visible = False

    End If

End Sub

'------------------------------------------------------------------------------------------------------------------------------

Private Sub Form_Unload(Cancel As Integer)

    Set objOutlook = Nothing

    If IsLoaded("frmMenuPrincipal") Then

        Forms!frmMenuPrincipal.Visible = True

End If

End Sub

'------------------------------------------------------------------------------------------------------------------------------

Sub subMuestraDatos()

Dim i As Integer

On Error GoTo Final

    txtAdjuntos = ""

    txtBody = ""

    txtAsunto = myItem.Subject

    'myItem.Recipients.Item (1)

    txtBody = myItem.HTMLBody

    txtCuerpoPlano = myItem.Body

    txtCCP = myItem.CC

    'txtFecha = myItem.LastModificationTime

    txtFecha = myItem.ReceivedTime

    txtRemitente = myItem.SenderEmailAddress

    If myItem.UnRead = True Then

        lbEstatusLectura.Caption = "Sin leer"

    Else

        lbEstatusLectura.Caption = ""

    End If

    txtUltMovto = ObtItemsCapt("select max(noFolio) + 1 from tbRegFolios ")

    btnaTareas.Enabled = True

Exit Sub

Final:

    MsgBox Err.Description

        Exit Sub

End Sub

Sub web()

'representará nuestra futura instancia de la aplicación Internet Explorer

 Dim InternetExplorer As Object

 'creamos la instancia de Internet Explorer

 Set InternetExplorer = CreateObject("InternetExplorer.application")

With InternetExplorer

 'Mostramos la ventana de Internet Explorer

 .Visible = True

 'Le hacemos navegar a la pagina que queramos

 .navigate "www.gmail.com"

 End With

'Mientras la pagina no se haya cargado dejamos al navegador que haga lo que necesite hacer.

 Do Until InternetExplorer.ReadyState = 4:

 DoEvents

 Loop

end sub