我已经尽可能地复制了您的代码和环境。我创建了一个名为“个人文件夹 (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 可以显示它们。如果我是对的,您可以在移动它们之前尝试访问这些尸体。如果做不到这一点,您将需要一个例程来访问新移动的消息,但没有显示。