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中显示为空白。

我想通过显示移动电子邮件之前和移动电子邮件之后的图像，更好地了解我所说的内容。
enter image description here

在进一步调查中，我发现邮件大小保持不变，但MS Outlook无法显示该邮件的正文。

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

Answer 1

我尽可能地复制了您的代码和环境。我创建了一个名为“Personal Folders（2011）”的PST文件。我使用了与代码中相同的查找目标文件夹的方法。但我无法复制您报告的错误。我移动的消息显示为我所期望的。

BodyFormatProperty的Microsoft Visual Basic帮助说：

“在早期版本的Outlook中，BodyFormat属性为新创建的项目返回了olFormatUnspecified常量，该项目尚未显示或其BodyFormat属性尚未以编程方式设置。在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可以显示它们。如果我是对的，你可以尝试在移动它们之前访问它们。如果做不到这一点，你需要一个例程来访问新移动的消息但没有显示。

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

1 个答案: