Я продублировал ваш код и окружение настолько близко, насколько смогу. Я создал файл PST с именем «Личные папки (2011)». Я использовал тот же метод определения местоположения папки назначения, что и в вашем коде. Но я не могу дублировать ошибку, о которой вы сообщаете. Мои перемещенные сообщения отображаются так, как я ожидал.
Справка по Microsoft Visual Basic для BodyFormatProperty говорит:
- "В более ранних версиях 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 сможет их отобразить. Если я прав, вы можете попробовать получить доступ к телам, прежде чем перемещать их. В противном случае вам потребуется подпрограмма для доступа к недавно перемещенным сообщениям, но без отображения.