将电子邮件项目从一个位置移动到另一个位置后无法显示

Question

我正在尝试将电子邮件从一个地方移动到另一个地方。

示例代码来自 此处。

代码的重要部分，用于移动邮件：

If objVariant.Class = olMail Or objVariant.Class = olMeetingRequest Then

    ' This is optional, but it helps me to see in the
    ' debug window where the macro is currently at.
    Debug.Print objVariant.SentOn

    ' Calculate the difference in years between
    ' this year and the year of the mail object.
    intDateDiff = DateDiff("yyyy", objVariant.SentOn, Now)

    ' Only process the object if it isn't this year.
    If intDateDiff > 0 Then

        ' Calculate the name of the personal folder.
        strDestFolder = "Personal Folders (" & _
        Year(objVariant.SentOn) & ")"

        ' Retrieve a folder object for the destination folder.
        Set objDestFolder = objNamespace.Folders(strDestFolder).Folders("Inbox")

        ' Move the object to the destination folder.
        objVariant.Move objDestFolder

        ' Just for curiousity, I like to see the number
        ' of items that were moved when the macro completes.
        lngMovedMailItems = lngMovedMailItems + 1

        ' Destroy the destination folder object.
        Set objDestFolder = Nothing

    End If

现在，问题是，当它移动到目标文件夹时，只有邮件标题可见，邮件正文在 MS Outlook 中为空白。

我想通过显示移动电子邮件之前和移动电子邮件之后的图像来更好地了解我正在谈论的内容。

经过进一步调查，我发现邮件大小保持不变，但 MS Outlook 无法显示正文那个消息。

当我通过拖放或复制粘贴手动移动消息时，消息仍然正常。我能够看到消息正文。

Answer 1

我已尽可能地复制您的代码和环境。我创建了一个名为“个人文件夹 (2011)”的 PST 文件。我使用了与您的代码中相同的方法来定位目标文件夹。但我无法重复您报告的错误。我移动的消息按我的预期显示。

BodyFormatProperty 的 Microsoft Visual Basic 帮助说：

• “在 Outlook 的早期版本中，BodyFormat 属性为尚未显示的新创建项目或其 BodyFormat 属性尚未以编程方式设置的项目返回 olFormatUnspecified 常量。在 Microsoft Office Outlook 2003 中，该属性返回当前在 Outlook 用户界面中设置的格式。”

然而，我不相信这段文字。我遇到过在访问正文之前 BodyFormat 属性已损坏的情况。如果 Outlook 仅在 BodyFormat 属性具有有效值的情况下查找正文，您将出现您所描述的症状。这就是为什么我想知道（1）未损坏的正文是否确实存在于移动的消息中以及（2）以编程方式访问正文是否可以解决问题。

请运行以下宏（或类似的宏）并报告输出的性质。

Sub DebugMovedMessages()

  Dim Body As String
  Dim FolderTgt As MAPIFolder
  Dim ItemClass As Integer
  Dim ItemCrnt As Object
  Dim NameSpaceCrnt As NameSpace

  Set NameSpaceCrnt = CreateObject("Outlook.Application").GetNamespace("MAPI")

  ' ######### Adjust chain of folder names as required for your system
  Set FolderTgt = NameSpaceCrnt.Folders("Personal Folders (2011)") _
                                      .Folders("Inbox").Folders("CodeProject")

  For Each ItemCrnt In FolderTgt.Items
    With ItemCrnt

      ' This code avoid syncronisation errors
      ItemClass = 0
      On Error Resume Next
      ItemClass = .Class
      On Error GoTo 0

      If ItemClass = olMail Or ItemClass = olMeetingRequest Then
        Debug.Print IIf(ItemClass = olMail, "Mail", "Meeting") & _
                                                        " item " & .SentOn
        Body = .Body
        Debug.Print "  Length of text body = " & Len(Body)
        Call DsplDiag(Body, 4, 25)
        If ItemClass = olMail Then
        Body = .HTMLBody
        Debug.Print "  Length of html body = " & Len(Body)
        Call DsplDiag(Body, 4, 25)
        End If
      End If
    End With
  Next

End Sub
Sub DsplDiag(DsplStg As String, DsplIndent As Integer, DsplLen As Integer)

  Dim CharChar As String
  Dim CharInt As Integer
  Dim CharStg As String
  Dim CharWidth As Integer
  Dim HexStg As String
  Dim Pos As Integer
  Dim Printable As Boolean

  CharStg = Space(DsplIndent - 1)
  HexStg = Space(DsplIndent - 1)

  For Pos = 1 To DsplLen
    CharChar = Mid(DsplStg, Pos, 1)
    CharInt = AscW(CharChar)
    Printable = True
    If CharInt > 255 Then
      CharWidth = 4
      ' Assume Unicode character is Printable
    Else
      CharWidth = 2
      If CharInt >= 32 And CharInt <> 127 Then
      Else
        Printable = False
      End If
    End If
    HexStg = HexStg & " " & Right(String(CharWidth, "0") & _
                                               Hex(CharInt), CharWidth)
    If Printable Then
      CharStg = CharStg & Space(CharWidth) & CharChar
    Else
      CharStg = CharStg & Space(CharWidth + 1)
    End If
  Next

  Debug.Print CharStg
  Debug.Print HexStg

End Sub

对于有效的消息，这些宏将在立即窗口中输出如下所示的内容：

Mail item 23/12/2011 05:09:58
  Length of text body = 10172
     y  o  u  r     d  a  i  l  y     d  e  a  l              H  Y  P  E  R  L
    79 6F 75 72 20 64 61 69 6C 79 20 64 65 61 6C 20 09 0D 0A 48 59 50 45 52 4C
  Length of html body = 32499
     <  !  D  O  C  T  Y  P  E     h  t  m  l     P  U  B  L  I  C     "  -  /
    3C 21 44 4F 43 54 59 50 45 20 68 74 6D 6C 20 50 55 42 4C 49 43 20 22 2D 2F
Mail item 29/12/2011 11:03:38
  Length of text body = 173
     A  1  =  ¡     F  F  =  ÿ     1  0  0  =    A        1  E  0  0  =    ?      
    41 31 3D A1 20 46 46 3D FF 20 31 30 30 3D 0100 A0 20 31 45 30 30 3D 1E00 20 0D
  Length of html body = 0

我希望您得到这样的输出。也就是说，我希望消息体存在且正确。我进一步希望在访问这些正文后，Outlook 可以显示它们。如果我是对的，你可以在移动尸体之前尝试接触它们。如果做不到这一点，您将需要一个例程来访问新移动的消息，但不显示。