Run Time Error 430

[josros60]

I found the code below but every time I run gave me "Run-time error 430" Class does not support Automation or does not support expected interface:

Option Explicit
Dim n As Long
Sub Launch_Pad()
Dim olApp As Outlook.Application
Dim olNS As Outlook.Namespace
Dim olFolder As Outlook.MAPIFolder
Dim Date1 As Date
Dim Date2 As Date
Dim Subject As String
Dim Body As String
Application.ScreenUpdating = False
    Date1 = Range("J2").Value
    Date2 = Range("K2").Value
    Subject = Range("L2").Value
    Body = Range("M2").Value
    
    Set olApp = Outlook.Application
    Set olNS = olApp.GetNamespace("MAPI")
    Set olFolder = olNS.PickFolder
    
    Call ProcessFolder(olFolder, Subject, Body, Date1, Date2)
  Application.ScreenUpdating = True
    Set olFolder = Nothing
    Set olApp = Nothing
    Set olNS = Nothing
End Sub

Sub ProcessFolder(olfdStart As Outlook.MAPIFolder, _
    Subject As String, _
    Body As String, _
    StartDate As Date, _
    EndDate As Date)
Dim olObject As Object
Dim n As Long

    n = 2
    
    For Each olObject In olfdStart.Items
    
        If TypeName(olObject) = "MailItem" Then
        
            If Int(olObject.ReceivedTime) >= StartDate And Int(olObject.ReceivedTime) <= EndDate Then
            
                If olObject.Subject Like "*" & Subject & "*" Or Body & "*" Then

                    Cells(n, 1).Value = olObject.Subject
                    If Not olObject.UnRead Then Cells(n, 2).Value = "Message is read" Else Cells(n, 2).Value = "Message is unread"
                    Cells(n, 3).Value = olObject.ReceivedTime
                    Cells(n, 4).Value = olObject.LastModificationTime
                    Cells(n, 5).Value = olObject.Body
                    Cells(n, 6).Value = olObject.SenderName
                    Cells(n, 7).Value = olObject.FlagRequest
                    
                    n = n + 1
                End If
            End If
        End If
    Next
    
    Set olObject = Nothing
End Sub
Sub Formatting()
Application.ScreenUpdating = False
Range("E3").Select
    Range(Selection, Selection.End(xlDown)).Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Application.ScreenUpdating = True
End Sub

Sub DelLastRowCols()
Application.ScreenUpdating = False
Dim lastrow As Long
lastrow = Sheet1.Cells(Rows.Count, "A").End(xlUp).Row
Range("A3:G3" & lastrow).Select
Selection.Clear
Range("A2").Select
Application.ScreenUpdating = True
End Sub

Sub final()
Call DelLastRowCols
Call Launch_Pad
Call Formatting
End Sub

Thank you,

 

[josros60]

any help please?