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.