Проблема с макросом Outlook - иногда вложение не добавляется

Question

Я создал макрос, который прикрепляет выбранное письмо к сообщению и отправляет его на предварительно заполненный адрес.

Однако иногда макрос перестает прикреплять выбранное письмо.

Кто-нибудь может посоветовать, в чем может быть причина? Вот мой код.

Sub ForwardOutsource()

On Error Resume Next

Dim objItem As Outlook.MailItem

If Application.ActiveExplorer.Selection.Count = 0 Then
   MsgBox ("No item selected")
   Exit Sub
End If

For Each objItem In Application.ActiveExplorer.Selection
Set objMsg = Application.CreateItem(olMailItem)
    With objMsg
        .SentOnBehalfOfName = "info@info.com"
        .Attachments.Add objItem, olEmbeddeditem
        .Subject = objItem.Subject
        .To = "address@address.com"
        .Display
        End With
Next

Set objItem = Nothing
Set objMsg = Nothing

End Sub

Answer 1

Что ж, вам следует удалить On Error Resume Next из вашего кода, вы в основном говорите коду перейти к следующей строке, если произошла ошибка.

кстати, вы тоже не правильно его используете

Вот хорошая ссылка http://www.cpearson.com/Excel/ErrorHandling.htm

Затем попробуйте использовать Option Explicit и Объявить переменные

очистить ваш пример кода

Option Explicit
Public Sub Fw_Items_As_Atmt()
    '//  Declare variables
    Dim msg As Outlook.MailItem
    Dim Item As Outlook.MailItem

'    Select msg
    If Application.ActiveExplorer.Selection.Count = 0 Then
        MsgBox ("No Item selected")
        Exit Sub
    End If

    Set msg = Application.CreateItem(olMailItem)

    For Each Item In Application.ActiveExplorer.Selection

        With msg
            .Attachments.Add Item, olEmbeddeditem ' Attch Selected email
            .Subject = "See Attached Items"
            .To = ""
            .CC = ""
            .HTMLBody = ""
            .Display
        '    .Send
        End With
    Next

    '// Clean up
    Set Item = Nothing
    Set msg = Nothing
End Sub