Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    If Not Intersect(Target, Range("Таблица[[#ALL],[Столбец]]")) Is Nothing Then
        Dim Theme_Number As Integer
        Theme_Number = 0
        UserForm1.Show
        If Not Theme_Number = 0 Then Target.Value = Theme_Number
        Cancel = True
        Exit Sub
    End If
End Sub           

Private Sub Label1_Click()
    Dim Theme_Number As Integer 'потому что он начинает ругаться, если я не объявлю переменную
    Theme_Number = 1
    Unload Me
End Sub
'и так далее на каждый, нужный мне Label
Private Sub Label2_Click()
    Dim Theme_Number As Integer 'потому что он начинает ругаться, если я не объявлю переменную
    Theme_Number = 2
    Unload Me
End Sub

=ЕСЛИ($А2="Яблоко";Справочник!C$3$:C$6$;)

=ЕСЛИ($А2="Яблоко";Справочник!C$3$:C$6$;)

.Attachments.Add (myMsg(i))

.Attachment.Add myMsg(i)

.Attachments.Item(mymsg(i))

.Attachments.Add 

Set maillist = objnamespace.Folders("xxxx@mail.ru").Folders("Имя папки, в которой будем искать письма").Items
Rectime = "сюда вытягиваю из ячейки Excel время письма"

e = Format(Rectime, "ddddd hh:mm")
e = Format(DateAdd("n", -1, e), "ddddd hh:mm")
e1 = Format(DateAdd("n", 2, e), "ddddd hh:mm")
strfilter = "[ReceivedTime]>'" & e & "' and [ReceivedTime]<'" & e1 & "'"
Set filtered_items = maillist.Restrict(strfilter)
fitems = filtered_items.Count
If fitems >0 Then
    For i = 1 To Fitems
        If filtered_items(i).ConversationID = "ссылка на ячейку Excel" And Rectime = Cstr(filtered_items(i).ReceivedTime) Then
            Set olreply = filtered_items(i).Forward
            With olreply
                .SentOnBehalfOfName = "yyy@mail.ru"
                .To = "yyy@mail.ru"
                .Subject = "Тема письма"
                .Send '.Display
            End With
        End If
    Next
Else
    MsgBox "Письмо не найдено в папке Обработанные"
    Cancel = True
    Exit Sub
End If

if Time > TimeValue("23:00:00") And Time < TimeValue("06:00:00")

Sub CheckReport 
    Dim olApp As Outlook.Application, objnamespace As Namespace
    Dim mail_name As String
    Set olApp = New Outlook.Application
    Set objnamespace = olApp.GetNamespace("MAPI")
    mail_name = ThisWorkbook.Worksheets("Список").Cells(2,2) 'название ящика считывается из ячейки в файле Excel
    Set items_post_tf = objnamespace.Folders(mail_name).Folders("Отчеты") 'наименование папки в ящике, в которой будем смотреть письма
    Set items_mail_tf = item_post_tf.Items
    
    CheckTime = Format(DateAdd("n", -60, Now()), "dddd hh:mm") 'Считаем минус 1 час от текущего времени, для установки фильтра
    strfilter = "[ReceivedTime]>'" & CheckTime & "'" 'параметры фильтра, который будет применяться к папке значение времени поступления письма больше CheckTime
    Set filtered_items = items_mail_tf.Restrict(strfilter) 'применение фильтра по параметрам выше
    CounterTF = filtered_items.Count 'подсчет количества писем удовлетворяющих условию
    If CounterTF = 0 MsgBox "Новые отчеты в течение часа не поступали"
End Sub