3

メールをある pst から別の pst に移動しようとしています。

サンプルコードはこちらから。

メッセージを移動するコードの重要な部分:

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

さて、問題は、宛先フォルダーに移動すると、メッセージヘッダーのみが表示され、MS Outlook でメッセージ本文が空白になることです。

引っ越し前のメールと引っ越し後のメールの画像を表示することで、私が話していることをよりよく理解できるようにしたいと思います。
ここに画像の説明を入力 ここに画像の説明を入力

さらに調査したところ、メッセージのサイズは同じままであることがわかりましたが、MS Outlook はそのメッセージの本文を表示できません。

ドラッグアンドドロップまたはコピーペーストを使用して手動でメッセージを移動しても、メッセージは問題ありません。メッセージ本文を見ることができます。

4

1 に答える 1

1

あなたのコードと環境をできる限り忠実に複製しました。「個人用フォルダー (2011)」という名前の PST ファイルを作成しました。コードと同じ方法で宛先フォルダーを見つけました。しかし、あなたが報告したエラーを複製することはできません。移動したメッセージが期待どおりに表示されます。

BodyFormatProperty の Microsoft Visual Basic ヘルプは次のように述べています。

  • 「以前のバージョンの Outlook では、BodyFormat プロパティは、表示されていない、または BodyFormat プロパティがプログラムによってまだ設定されていない、新しく作成されたアイテムの olFormatUnspecified 定数を返しました。Microsoft Office Outlook 2003 では、プロパティは、現在設定されている形式を返しますOutlook ユーザー インターフェイスです。」

しかし、私はこのテキストを信じていません。本文にアクセスするまで BodyFormat プロパティが破損しているケースに遭遇しました。BodyFormat プロパティに有効な値がある場合にのみ Outlook が本文を検索すると、説明した現象が発生します。これが、（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 で表示できることを願っています。私が正しければ、体を移動する前に体にアクセスしてみてください。そうしないと、新しく移動されたメッセージにアクセスするためのルーチンが必要になりますが、表示はありません。

于 2011-12-29T11:56:38.633 に答える