Код не выполняет цикл из-за ошибки типа запуска 13 outlook

Question

Я пытаюсь перечислить все темы электронных писем в определенной папке.Я получаю Run time Error 13, как только товар, а не письмо, т.е. назначение и т. Д.

Последующий вопрос:

1) Как ответить на все последние письма на основе темыи электронная почта может быть в папке «Входящие» или отправленных.

2) Как зациклить все электронные письма в папке, например, нажав «Нажмите здесь, чтобы узнать больше о преимуществах Microsoft», вы получите доступ ко всем старым электронным письмам.

Sub AccessInbox2()

'Early binding

Dim Olook As Outlook.Application ' to access all the libraries of outlook
Dim OmailItem As Outlook.MailItem ' To access emails in the inbox
Dim ONameSpace As Outlook.Namespace ' it is class which opens the gate for you to access all outlook folders. Unlike the Folder class, it exactly tells VBA which folder to use.
Dim Fol As Outlook.Folder ' Where we have emails with attachments stored
Dim Atmt As Outlook.Attachment ' a class which will help us in dealing wiht emails which as attachements
Dim TotalEmails As Long
Dim i As Integer


Set Olook = New Outlook.Application
Set OmailItem = Olook.CreateItem(olMailItem) 'to deal with emails

'messaging application protocal interface
i = 1
For Each OmailItem In Olook.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Folders("Goldy").Items

    'If TypeName(OmailItem) = "MailItem" Then
    If OmailItem.Class = 43 Then

    Sheet1.Cells(i, 7).Value = OmailItem.Subject

    End If

i = i + 1
Next

End Sub

Answer 1

Как насчет следующего ...

Option Explicit
Public Sub AccessInbox2()
'Early binding
    Dim Olook As Outlook.Application ' to access all the libraries of outlook
    ' it is class which opens the gate for you to access
    ' all outlook folders. Unlike the Folder class,
    ' it exactly tells VBA which folder to use.

    Set Olook = New Outlook.Application

    Dim Sht As Worksheet
    Set Sht = ThisWorkbook.Sheets("Sheet1")



    Dim Items As Outlook.Items
    Set Items = Olook.GetNamespace("MAPI") _
                     .GetDefaultFolder(olFolderInbox) _
                     .Folders("Goldy").Items

   Dim i As Long
   Dim LastRow As Long
   For i = Items.Count To 1 Step -1

        If TypeOf Items(i) Is Outlook.MailItem Then
            Debug.Print Items(i).Subject ' Print on Immediate Window

            With Sht

                 LastRow = .Cells(.Rows.Count, 7).End(xlUp).Row + 1
                 Debug.Print .Cells(LastRow, 7).Address ' Print on Immediate Window
                .Cells(LastRow, 7).Value = Items(i).Subject

            End With

        End If

    Next

End Sub