Object not found from inputbox; need to handle error

[jrake40]

My input box fills the inboxfldr in this code Set Fldr = olNs.GetDefaultFolder(olFolderInbox).Folders(inboxfldr). If the object isn't found the vba gives a run time error. I want to suppress that error, prompt a message box that folder isn't found and just re-promt my inputbox. Looking for some help.

Sub GetFromInbox()

Dim olApp As Outlook.Application
Dim olNs As Namespace
Dim Fldr As MAPIFolder
Dim olMail As Variant
Dim DateCount As Integer
Dim myDate1 As Date
Dim myDate2 As Date


Dim item As Object
Dim doClip As MSForms.DataObject
Dim xlApp As Object ' Excel.Application
Dim xlWkb As Object


inboxfldr = InputBox("Enter Outlook Folder Name", "Inbox Alert Folder")


Set olApp = New Outlook.Application
Set olNs = olApp.GetNamespace("MAPI")
Set Fldr = olNs.GetDefaultFolder(olFolderInbox).Folders(inboxfldr)
Set doClip = New MSForms.DataObject


    
x = Date
myDate1 = Sheets("Inbox Alerts").Range("A1").Value
myDate2 = Sheets("Inbox Alerts").Range("B1").Value


For Each olMail In Fldr.Items
    If DateSerial(Year(olMail.ReceivedTime), Month(olMail.ReceivedTime), Day(olMail.ReceivedTime)) >= myDate1 And _
       DateSerial(Year(olMail.ReceivedTime), Month(olMail.ReceivedTime), Day(olMail.ReceivedTime)) <= myDate2 And _
       InStr(olMail.Subject, "Alert") >= 0 _
    Then
        doClip.SetText olMail.Body
        doClip.PutInClipboard
        
        Sheets("Inbox Alerts").Cells(Rows.count, 1).End(xlUp).Offset(1, 0).PasteSpecial "Text"
       DateCount = DateCount + 1
    End If
Next olMail


Set Fldr = Nothing
Set olNs = Nothing
Set olApp = Nothing
End Sub

 

[CalcSux78]

You could add a loop to verify that the folder exists. (I'm sure there's cleaner ways)

Add the blue text.

Sub GetFromInbox()


Dim olApp As Outlook.Application
Dim olNs As Namespace
Dim Fldr As MAPIFolder
Dim olMail As Variant
Dim DateCount As Integer
Dim myDate1 As Date
Dim myDate2 As Date
[COLOR=#0000ff][B]Dim oFolders As Folders, oFolder As Folder[/B][/COLOR]
[COLOR=#0000ff][B]Dim bFound As Boolean[/B][/COLOR]


Dim item As Object
Dim doClip As MSForms.DataObject




[B][COLOR=#0000ff]NoMatch:[/COLOR][/B]
[B][COLOR=#0000ff]inboxfldr= InputBox("Enter Outlook Folder Name", "Inbox Alert Folder")[/COLOR][/B]
[B][COLOR=#0000ff]If inboxfldr= "" Then Exit Sub[/COLOR][/B]


Set olApp = New Outlook.Application
Set olNs = olApp.GetNamespace("MAPI")


[COLOR=#008000][B]'check for match[/B][/COLOR]
[COLOR=#0000ff][B]Set oFolders = Ns.GetDefaultFolder(olFolderInbox).Parent.Folders[/B][/COLOR]
[COLOR=#0000ff][B]For Each oFolder In oFolders[/B][/COLOR]
[COLOR=#0000ff][B]    If oFolder.Name = INBOXFLDR Then bFound = True[/B][/COLOR]
[COLOR=#0000ff][B]Next oFolder[/B][/COLOR]
[COLOR=#0000ff][B]If Not bFound Then[/B][/COLOR]
[COLOR=#0000ff][B]    MsgBox "Folder does not exist."[/B][/COLOR]
[COLOR=#0000ff][B]    GoTo NoMatch[/B][/COLOR]
[COLOR=#0000ff][B]End If[/B][/COLOR]


Set Fldr = olNs.GetDefaultFolder(olFolderInbox).Folders(INBOXFLDR)
Set doClip = New MSForms.DataObject

...