I am trying to move email from one pst to another.
Sample code from here.
The important part of the code, which moves the message:
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
Now, problem is, when it moves to the destination folder, only message headers are visible, message body comes blank in MS outlook.
I'd like to give a better idea of what I am talking about, by showing the images of before move email and after move email.
On further investigating, I found message size remain same, but MS Outlook is not able to display the body of that message.
When, I move a message manually, either via Drag and drop or copy paste, message remains fine. I am able to see Message body.
I have duplicated your code and environment as closely as I can. I have created a PST file named "Personal Folders (2011)". I have used the same method of locating the destination folder as in your code. But I cannot duplicate the error you report. My moved messages display as I would expect.
Microsoft Visual Basic Help for BodyFormatProperty says:
However, I do not believe this text. I have encountered cases where the BodyFormat property is corrupt until the body is accessed. If Outlook only looks for the body if the BodyFormat property has a valid value, you would get the symptoms you describe. This is why I wish to know (1) if the uncorrupted body is actually present in the moved messages and (2) if accessing the bodies programmatically fixes the problem.
Please run the following macros (or something like them) and report the nature of the output.
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
For valid messages, these macros will output something like the following to the immediate window:
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
What I hope is that you get output like this. That is, I hope the message bodies are present and correct. I further hope that having accessed the bodies, Outlook can display them. If I am right, you could try accessing the bodies before moving them. Failing that, you would need a routine to access the newly moved messages but without the display.