通过 Outlook 发送 email 后 VBA 错误 462“远程服务器计算机不存在或不可用”

Question

我编写了一个 VBA 代码，该代码通过收件箱中的电子邮件并在满足指定条件时转发它们。 对我来说，它工作正常。 不幸的是，一个用户在转发第一个 email 后收到错误 462（如果不满足条件，它将通过循环并检查下一项，在转发第一封可能的电子邮件后出现错误）。

    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

错误出现在“下一项”（粗体）行中。 如果没有使用快捷方式发送 email 的代码的粗体部分（仅显示消息），它可以正常工作。 我尝试了后期绑定和早期绑定，结果相同。 看起来在发送一个 email 之后它“丢失”了对 outlook 应用程序的引用？ 你对如何解决它有什么建议吗？

Answer 1

如果您想让 Outlook 一直运行直到完成，请尝试获取Explorer实例并使其保持活动状态。

另外，我注意到以下代码：

For Each Item In myMails

遍历文件夹中的所有项目是一项耗时的任务，并且绝对不推荐使用 go 的方法。 相反，您可以考虑改用Restrict或Find / FindNext方法。 在以下文章中阅读有关这些方法的更多信息：

• 如何：使用 Find 和 FindNext 方法从文件夹中检索 Outlook 邮件项目（C#、VB.NET）
• 如何：使用限制方法从文件夹中检索 Outlook 邮件项目