vba - 将电子邮件项目从一个PST移到另一个PST后，无法显示

Question

我正在尝试将电子邮件从一个PST转移到另一个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可以访问它们，并显示它们。如果我是对的，可以在移动它们之前尝试访问它们。否则，您将需要一个例程来访问新移动的消息，但不显示消息。