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

Question

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

来自here 的示例代码。

代码的重要部分，移动消息：

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 可以显示它们。如果我是对的，您可以在移动它们之前尝试访问这些尸体。否则，您将需要一个例程来访问新移动的消息，但没有显示。