excel - 出现运行时错误“-2147221233 (8004010f)”，然后出现运行时错误“462”远程服务器机器不存在或不可用

Question

以下代码曾经可以工作，但突然开始产生上述错误消息。它旨在从文件夹中的每封电子邮件中获取联系方式，然后发送一封新电子邮件。我已经运行了错误检查并且失败的行是： Set objFolder = objFolder.Folders("Inbox").Folders("Test") 这是代码：

Sub ListMailsInFolder()

    Dim objNS As Outlook.Namespace
    Dim objFolder As Outlook.MAPIFolder
    Dim Lines() As String

    Set objNS = GetNamespace("MAPI")
    Set objFolder = objNS.Folders.GetFirst ' folders of your current account
    Set objFolder = 
 objFolder.Folders("Inbox").Folders("Test")
 Worksheets("Sheet2").Cells.ClearContents
 a = 1
    For Each Item In objFolder.Items
        If TypeName(Item) = "MailItem" Then
            Item.Display
            Worksheets("Sheet2").Cells(1, a).Value = 
 Item.Body
            Item.Close 1
            a = a + 1
            Debug.Print Item.ConversationTopic
        End If
    Next

 For x = 1 To 208
 If Worksheets("Sheet2").Cells(1, x) = "" Then
 Exit For
 End If
  Set OutApp = CreateObject("Outlook.Application")
  Set objOutlookMsg = OutApp.CreateItem(olMailItem)

  Set Recipients = objOutlookMsg.Recipients
  Set objOutlookRecip = 
 Recipients.Add("<email removed for forum>")
  objOutlookRecip.Type = 1

  objOutlookMsg.SentOnBehalfOfName = 
 "<email removed for forum>"
  objOutlookMsg.Subject = "Fleet Insurance"
  objOutlookMsg.Body = "Testing this macro" & vbCrLf & 
 vbCrLf & "First Name: " & Worksheets("Sheet3").Cells(7, x) & vbCrLf & "Last Name: " & Worksheets("Sheet3").Cells(10, x) & vbCrLf & "Email Address: " & Worksheets("Sheet3").Cells(14, x)
  'Fleet client relationship team in signature
  'Resolve each Recipient's name.
  For Each objOutlookRecip In objOutlookMsg.Recipients
    objOutlookRecip.Resolve
  Next
  objOutlookMsg.Send
  'objOutlookMsg.Display

  Set OutApp = Nothing
  Next x

End Sub

标签： excelvbaoutlook

Answer 1

要可靠地引用默认收件箱：

Option Explicit

Sub ListMailsInDefaultAccountFolder()

    Dim objNS As Namespace
    Dim objFolder As Folder
    Dim defInboxFolder As Folder

    Dim itmCount As Long
    Dim i As Long

    Set objNS = GetNamespace("MAPI")

    Set defInboxFolder = objNS.GetDefaultFolder(olFolderInbox)
    Set objFolder = defInboxFolder.Folders("Test")

    itmCount = objFolder.Items.Count

    For i = 1 To itmCount
        Debug.Print objFolder.Items(i).Subject
    Next

End Sub