无法通过 Excel vba 搜索存档的 Outlook 电子邮件答案

【问题标题】：Unable to search archived Outlook email through Excel vba无法通过 Excel vba 搜索存档的 Outlook 电子邮件
【发布时间】：2022-11-09 05:21:04
【问题描述】：

我已经创建了宏来搜索带有特定主题名称的 Outlook 最新电子邮件，然后通过将 Excel 中的一些范围粘贴到电子邮件正文中进行转发，并且该代码适用于最近的电子邮件。但不适用于存档的电子邮件。当我搜索旧电子邮件时，我收到“类型不匹配”错误。

这是代码：

Sub Online_Email()
  Dim outlookApp As Variant
  Dim olNs As Outlook.Namespace
  Dim Fldr As Outlook.MAPIFolder
  Dim olMail As Outlook.MailItem
  Dim olFMail As Outlook.MailItem
  Dim myTasks As Variant
  Dim sir() As String
  Dim rng As Range
Dim wb As Workbook
  Dim obwb As Workbook
  'Set outlookApp = New Outlook.Application
  Set outlookApp = CreateObject("Outlook.Application")

  Set olNs = outlookApp.GetNamespace("MAPI")
  Set Fldr = olNs.GetDefaultFolder(olFolderInbox)
  Set myTasks = Fldr.Items
  
  
For Each wb In Workbooks
If wb.Name Like "Consolidated observation file*.xlsb" Then

Set obwb = wb

obwb.Activate
Exit For
End If
Next

  
  
  lastrow = obwb.Sheets("Daily Observation").Range("F50000").End(xlUp).Row
  Set rng = obwb.Sheets("Daily Observation").Range(Cells(8, 1), Cells(lastrow, 6)).SpecialCells(xlCellTypeVisible)
  
  '
  'Set olMail = myTasks.Find("[Subject] = ""123456""")
  '
  For Each olMail In myTasks
  '
    If (InStr(1, olMail.Subject, "Consolidated Observations", vbTextCompare) > 0) Then
      Set olFMail = olMail.Forward
           With olFMail
           .To = "Pravin.Angane@eclerx.com;Jaysing.Pardeshi@eclerx.com;Suhas.Bhange@eclerx.com;Dadasaheb.Kamble@eclerx.com"
           .CC = "Jaysing.Pardeshi@eclerx.com;Suhas.Bhange@eclerx.com"
           .HTMLBody = "<HTML><BODY>" & obwb.Sheets("AutoMail").Range("a1") & "<br><br>" & obwb.Sheets("AutoMail").Range("a2") & "</BODY></HTML>" & RangetoHTML(rng) & olFMail.HTMLBody
           .Subject = obwb.Sheets("AutoMail").Range("i3")
           End With
           Set Myattachments = olFMail.Attachments
 
        While Myattachments.Count > 0
 
         Myattachments.Remove 1
 
         Wend
        olFMail.Attachments.Add "\\IPSAABACUS\CM_Shared$\SalesForce\Jyoti Sahay\VA-Training\Scrubbing feedback\Observations\Consolidated observation file - Oct-2022.rar"
        
           
        
          olFMail.Display
      Exit For
    End If
  Next




    'Dim outForward As Outlook.MailItem
    
    'Set outForward = ActiveExplorer.Selection.Item(1).Forward
    'outForward.Recipients.Add "pravin.angane@eclerx.com"
    'outForward.Save


End Sub

Function RangetoHTML(rng As Range)
    Dim obj As Object
    Dim txtstr As Object
    Dim File As String
    Dim wb As Workbook
    File = Environ$("temp") & "\" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
    rng.Copy
    Set wb = Workbooks.Add(1)
    With wb.Sheets(1)
        .Cells(1).PasteSpecial Paste:=8
        .Cells(1).PasteSpecial xlPasteValues, , False, False
        .Cells(1).PasteSpecial xlPasteFormats, , False, False
        .Cells(1).Select
        .Cells.EntireColumn.AutoFit
        Application.CutCopyMode = False
        On Error Resume Next
        .DrawingObjects.Visible = True
        .DrawingObjects.Delete
        On Error GoTo 0
    End With
    With wb.PublishObjects.Add( _
         SourceType:=xlSourceRange, _
         Filename:=File, _
         Sheet:=wb.Sheets(1).Name, _
         Source:=wb.Sheets(1).UsedRange.Address, _
         HtmlType:=xlHtmlStatic)
        .Publish (True)
    End With
    Set obj = CreateObject("Scripting.FileSystemObject")
    Set txtstr = obj.GetFile(File).OpenAsTextStream(1, -2)
    RangetoHTML = txtstr.readall
    txtstr.Close
    RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                          "align=left x:publishsource=")
    wb.Close savechanges:=False
    Kill File
    Set txtstr = Nothing
    Set obj = Nothing
    Set wb = Nothing
End Function

【问题讨论】：

在哪里具体来说，您是否看到该错误？
如果不知道根据@TimWilliams 评论收到错误的确切行，很难诊断您的问题，但我的钱是您的收件箱中有非MailItem 项目，因此错误出现在For Each olMail In myTasks 行或Next 行...如果是这种情况，可以提供一个相当简单的答案（但我没有足够的空间将其放在评论中）！

标签： excel vba excel-formula outlook office-automation

【解决方案1】：

首先，您需要记住 Outlook 文件夹可能包含不同类型的项目 - 约会、便笺、邮件等。因此，当您遍历代码中的所有项目时，使用对象进行迭代并检查其类型是有意义的使用 MessageClass 属性或仅使用以下代码：

If TypeName(Item) = "MailItem" Then

其次，遍历文件夹中的所有项目并不是一个好主意。使用Find/FindNext 或Restrict 方法获取与您的条件相对应的项目。在我为技术博客撰写的文章中阅读有关这些方法的更多信息：

【讨论】：