Question

以下代码曾经起作用，但突然开始产生上述错误消息。它旨在从文件夹中的每封电子邮件中获取详细联系信息，然后发送新的电子邮件。我已经运行了错误检查，但失败的行是：设置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

Answer 1

错误代码为MAPI_E_NOT_FOUND。确保“收件箱”下存在名为“测试”的文件夹。

Answer 2

您正在寻找的文件夹很可能丢失了（不是根据Outlook，而是根据您的代码）。发生这种情况的一个原因是您的收件箱更改了名称，如果您使用的不是英文Outlook，则可以这样做。试试这个：

Set objFolder = objNS.Folders.GetFirst
For Each folder In objFolder.Folders
    Debug.Print folder.Name
Next

它列出了收件箱所在的所有文件夹。希望您会找到一些可以识别为收件箱的内容。在代码中替换该名称。

正在获取运行时错误'-2147221233（8004010f）'，然后获取运行时错误'462'远程服务器计算机不存在或不可用

2 个答案: