Thank you for Visiting my Blog

Sunday, 26 March 2017

How to connect to OUTLOOK mailbox using Macros




Sub Mail_Connection()

' You need to use this module with the RangetoHTML subroutine.
' Works in Excel 2000, Excel 2002, Excel 2003, Excel 2007, Excel 2010, Outlook 2000, Outlook 2002, Outlook 2003, Outlook 2007, and Outlook 2010.


    Dim OutApp As Object
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With
    Set OutApp = CreateObject("Outlook.Application")

    On Error Resume Next
    Dim objSentFolder As Outlook.MAPIFolder
    Dim myItems As Outlook.Items
    Dim sFilter As String
    Dim mySubject As String
    Dim myItem As Outlook.MailItem
    Dim Mail_count As Integer
   
    Set objSentFolder = _
    OutApp.GetNamespace("MAPI").GetDefaultFolder(6).Folders("temp")
 
    Set myItems = objSentFolder.Items
    mySubject = "Good Morning"
   
    sFilter = "[Subject] = '" & mySubject & "'"
    myItem = myItems.Find(sFilter)
    Mail_count = myItems.Count

   
    For i = 1 To Mail_count
       If mySubject = myItems(i).Subject Then
            ThisWorkbook.Worksheets("temp").Range("A" & i).Value = myItems(i).Body
       End If
   
    Next i
   
  
    On Error GoTo 0

    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub
 

No comments:

Post a Comment