vbaoutlookmovepst

Not able to display email items after moving them from one pst to another

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.
enter image description here enter image description here

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.

Solution

  • 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.