Ошибка VBA 462 «Удаленный серверный компьютер не существует или недоступен» после отправки электронной почты через Outlook

Question

Я написал код VBA, который просматривает электронные письма в папке «Входящие» и пересылает их, если выполняются указанные условия. У меня все работает правильно. К сожалению, один пользователь получает ошибку 462 после пересылки первого электронного письма (если условия не соблюдены, он проходит l oop и проверяет следующие элементы, ошибка появляется после пересылки первого возможного письма).

    Sub ForwardEmails(Optional bSend As Boolean = True)
    Dim olApp As Object
    Dim objNS As Object
    Dim sFolder As Object
    Dim sInbox As String, sName As String
    Dim Item As Object, ForwardItem As Object
    Dim i As Integer, iDateDiff As Integer
    Dim dDate As Date, dItemTime As Date
    Dim bForward As Boolean
    Set olApp = CreateObject("Outlook.Application")
    Set objNS = olApp.GetNamespace("MAPI")

    Dim myMails

    sInbox = "Inbox"

    ''''''''go to indicated Outlook account and subfolders
    On Error GoTo NoAccount
        Set sFolder = objNS.Folders(sAccount).Folders(sInbox)
    On Error GoTo 0

    dStartTime = Now
    Set myMails = sFolder.Items

    '''''''go through all items in inbox
    i = 4
    myMails.Sort "ReceivedTime", False

    For Each Item In myMails
        dItemTime = 0
        On Error Resume Next
            dItemTime = Item.receivedtime
            If dItemTime = 0 Then
                dItemTime = Item.creationtime
            End If
        On Error GoTo 0
        If dItemTime > 0 Then 'message type email, report etc, something that contains received time or creation time
            If dItemTime >= dStartDate Then

                If dItemTime <= dStartTime Then

                   If Len(Item.Categories) = 0 Then 'if email is not not categorized then proceed
                    bForward = True
                        If Len(sNotForward) > 0 Then 'if there is a restriction (text for not forwarded emails) then check
                            If Item.body Like "*" & sNotForward & "*" Then
                                bForward = False
                            End If
                        End If
                        If Len(sNotForward2) > 0 Then 'if there is a restriction (text for not forwarded emails) then check
                            If Item.body Like "*" & sNotForward2 & "*" Then
                                bForward = False
                            End If
                        End If
                        If bForward Then
                            Item.Categories = sCategory
                            Item.Save
                            Set ForwardItem = Nothing
                            On Error Resume Next
                                Set ForwardItem = Item.Forward
                            On Error GoTo 0
                            If ForwardItem Is Nothing Then 'if the type is different than olMail or similar and item can't be forwarded - create new item and attach the original item
                                Set ForwardItem = olApp.CreateItem(olMailItem)
                                ForwardItem.SentOnBehalfOfName = sSender
                                ForwardItem.attachments.Add Item
                                ForwardItem.Subject = "FW: " & Replace(Item.Subject, "Undeliverable: ", "")
                                ForwardItem.display
                                Call RemoveSignature
                            End If
                            ForwardItem.Recipients.Add sRecipient
                            ForwardItem.SentOnBehalfOfName = sSender
                            ForwardItem.display

                            **If bSend Then
                                'ForwardItem.send
                                Application.Wait (Now + TimeValue("00:00:03"))
                                Application.SendKeys "%s"
                                Application.Wait (Now + TimeValue("00:00:03"))
                            End If**


                            i = i + 1
                        End If
                   End If
                End If
            End If
        End If
    **Next Item**
    Set myMails = Nothing
    Set objNS = Nothing
    Set olApp = Nothing
    MsgBox "Completed. Forwarded " & i - 4 & " messages."
    Exit Sub

NoAccount:
    MsgBox "No such account or folder."
End Sub

Ошибка отображается в строке «Следующий элемент» (жирный шрифт). Без выделенной жирным шрифтом части кода, который отправляет электронное письмо с помощью ярлыка (сообщение только отображается), он работает без ошибок. Я попробовал позднюю привязку и раннюю привязку с тем же результатом. Похоже, что после отправки одного электронного письма он теряет ссылку на приложение Outlook? У вас есть предложения, как решить эту проблему?

Answer 1

Попробуйте получить экземпляр Explorer и оставить его в живых, если вы хотите, чтобы Outlook работал, пока не закончите.

Кроме того, я заметил следующий код:

For Each Item In myMails

Перебор всех элементов в папке - трудоемкая задача и определенно не рекомендуется для go. Вместо этого вы можете рассмотреть возможность использования методов Restrict или Find / FindNext. Дополнительные сведения об этих методах см. В следующих статьях:

• Как: использовать методы Find и FindNext для извлечения элементов почты Outlook из папки (C#, VB. NET)
• Как: использовать метод ограничения для извлечения элементов почты Outlook из папки