Automatically send arriving emails in a specific folder to Excel, constantly checking for new emails

Question

This is what I have from a forum that I changed slightly to suit.

It pulls the data but only runs when I manually start it.

I need it to constantly check for new emails or periodically check every minute or set interval of seconds.

Option Explicit

Private Sub CommandButton1_Click()

    On Error GoTo ErrHandler
    ' Set Outlook application object.
    Dim objOutlook As Object
    Set objOutlook = CreateObject("Outlook.Application")

    Dim objNSpace As Object     ' Create and Set a NameSpace OBJECT.
    ' The GetNameSpace() method will represent a specified Namespace.
    Set objNSpace = objOutlook.GetNamespace("MAPI")

    Dim myFolder As Object  ' Create a folder object.
    Set myFolder = objNSpace.GetDefaultFolder(olFolderInbox).Folders("Automation")

    Dim objItem As Object
    Dim iRows, iCols As Integer

    iRows = 2

    ' Loop through each item in the folder.
    For Each objItem In myFolder.Items
        If objItem.Class = olMail Then
            Dim objMail As Outlook.MailItem
            Set objMail = objItem
            Cells(iRows, 4) = objMail.SenderEmailAddress
            Cells(iRows, 1) = objMail.ReceivedTime
            Cells(iRows, 5) = objMail.body
            Cells(iRows, 3) = objMail.SenderName
        End If
        iRows = iRows + 1
    Next
    Set objMail = Nothing

    ' Release.
    Set objOutlook = Nothing
    Set objNSpace = Nothing
    Set myFolder = Nothing

ErrHandler:
    Debug.Print Err.Description
End Sub

Answer 1

You can handle the ItemAdd event on the Automation folder in Outlook, so you don't need to run the VBA macro manually and automate Outlook. A raw sketch may look like that:

Public WithEvents myOlItems As Outlook.Items 

Public Sub Application_Startup() 
 
 Set myOlItems = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Folders("Automation").Items 
 
End Sub 
 

Private Sub myOlItems_ItemAdd(ByVal Item As Object) 
 
  If Item.Class = olMail Then
    Dim objMail As Outlook.MailItem
    Set objMail = Item
    worksheet.Cells(iRows, 4) = objMail.SenderEmailAddress
    workheet.Cells(iRows, 1) = objMail.ReceivedTime
    worksheet.Cells(iRows, 5) = objMail.body
    workdheet.Cells(iRows, 3) = objMail.SenderName
  End If  
End Sub

Note, you need to add code for opening an Excel workbook to add new entries from items added to the Automation folder.