Visual Basic para Aplicaciones - Crear regla OUTLOOK

Private Sub Application_NewMail()

    Dim olItem As Object

    Set olItem = Application.Session.GetDefaultFolder(olFolderInbox).Items.GetLast()

    Dim xlApp As Object

    Dim sourceWB As Workbook

    Dim sourceWS As Worksheet

    Dim ruta As String

    Dim strCol, strColC, strColD, strColE, strColF, strColG As String

    strColB = olItem.SenderName

    strColC = olItem.SenderEmailAddress

    strColD = olItem.Subject

    strColE = olItem.Body

    strColF = olItem.To

    strColG = olItem.ReceivedTime

    If Left(strColD, 5) = "ASUNTO" Then

        ruta = "C:\Users\NOMBRE_EXCEL.XLSM"

        Set xlApp = CreateObject("Excel.Application")

        With xlApp

            .Visible = True

            .EnableEvents = False

        End With

        Set sourceWB = Workbooks.Open(ruta)

    End If

End Sub

Shell "Excel.exe " & ruta

Option Explicit

Const SW_SHOWDEFAULT = 10

Const SE_ERR_FNF = 2&

Const SE_ERR_PNF = 3&

Const SE_ERR_ACCESSDENIED = 5&

Const SE_ERR_OOM = 8&

Const SE_ERR_DLLNOTFOUND = 32&

Const SE_ERR_SHARE = 26&

Const SE_ERR_ASSOCINCOMPLETE = 27&

Const SE_ERR_DDETIMEOUT = 28&

Const SE_ERR_DDEFAIL = 29&

Const SE_ERR_DDEBUSY = 30&

Const SE_ERR_NOASSOC = 31&

Const ERROR_BAD_FORMAT = 11&

Private Declare Function GetDesktopWindow Lib "user32" () As Long

Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _

    (ByVal hwnd As Long, ByVal lpszOp As String, _

     ByVal lpszFile As String, ByVal lpszParams As String, _

     ByVal LpszDir As String, ByVal FsShowCmd As Long) _

     As Long

Function StartDoc(DocName As String) As Long

    Dim Scr_hDC As Long

    Scr_hDC = GetDesktopWindow()

    StartDoc = ShellExecute(Scr_hDC, "Open", DocName, _

    "", "C:\", SW_SHOWDEFAULT)

End Function

StarDoc Ruta