Run Time Error 430

josros60

Well-known Member
Joined
Jun 27, 2010
Messages
524
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:


VBA Code:
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,
 

Attachments

  • FIND_EMAIL.PNG
    FIND_EMAIL.PNG
    12.6 KB · Views: 6

Some videos you may like

Excel Facts

What did Pito Salas invent?
Pito Salas, working for Lotus, popularized what would become to be pivot tables. It was released as Lotus Improv in 1989.

Watch MrExcel Video

Forum statistics

Threads
1,127,035
Messages
5,622,332
Members
415,894
Latest member
silverhaze

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top