1

以下のコードを参照してください。私が書いたサブルーチンは、今日届いたすべての電子メールを調べて、「毎日の統計」という件名の電子メールのみを移動することになっています。「毎日の統計」という件名のメールを意図的に2通送信しました。受信トレイに、適切な件名のないメールがもう1つあります。全部で3通のメールがあります。Sub MoveHarpStatMailを実行すると、件名が「dailystats」の正しい電子メールの1つだけが移動します。もう1つは無視されているようです。私のフィルターストリングに何か厄介なものはありますか？私は別のサブルーチンでまったく同じフィルター文字列を使用しましたが、今日届いたすべての電子メールを読んで、そこでは完全に正常に機能します。どこが間違っているのかを指摘するもう1つの目が必要だと思います。

アラン

Public StatsArchiveFolder As Outlook.Folder
'StatsArchiveFolder is set elsewhere in another subroutine
Public Const SubjectTitle As String = "daily stats"
_______________________________________________

Sub MoveHarpStatMail()

Dim olapp As Outlook.Application
Dim olappns As Outlook.NameSpace
Dim oitem As Object
Dim ItemsToProcess As Outlook.Items
Dim myFolder As MAPIFolder
Dim sFilter As String
Dim tempMailItem As Outlook.MailItem

On Error GoTo LocalErr

'set outlook objects

Set olapp = New Outlook.Application
Set olappns = olapp.GetNamespace("MAPI")
Set myFolder = olappns.GetDefaultFolder(olFolderInbox)
'Filter for only MailItems received today
sFilter = "[ReceivedTime] >= " & AddQuotes(Format(Date, "ddddd"))
Set ItemsToProcess = Session.GetDefaultFolder(olFolderInbox).Items.Restrict(sFilter)

For Each oitem In ItemsToProcess
 If TypeName(oitem) = "MailItem" Then
   Set tempMailItem = oitem
   Debug.Print tempMailItem.Subject
   If CheckSubject(tempMailItem.Subject) Then
     MoveToArchiveFolder tempMailItem
   End If
 End If
Next oitem

ExitProc:
Set olapp = Nothing
Set olappns = Nothing
Set myFolder = Nothing
Set ItemsToProcess = Nothing

Exit Sub

LocalErr:
    If Err.Number <> 0 Then
     Msg = "Sub MoveHarpStatMail" & vbCrLf & "Error # " & Str(Err.Number) & " was generated by " _
         & Err.Source & Chr(13) & "Error Line: " & Erl & Chr(13) & Err.Description
     MsgBox Msg, , "Error", Err.HelpFile, Err.HelpContext
     End If
End Sub

____________________________________________

Private Function AddQuotes(MyText) As String
  AddQuotes = Chr(34) & MyText & Chr(34)
End Function

_______________________________________________

Sub MoveToArchiveFolder(Item As Outlook.MailItem)

    If StatsArchiveFolder Is Nothing Then
      MsgBox ("The ArchiveFolder object is not set.")
    End If

    Item.Move StatsArchiveFolder

End Sub
________________________________________________

Function CheckSubject(Subject As String) As Boolean

  If LCase(Trim(Subject)) = LCase(Trim(SubjectTitle)) Then
    CheckSubject = True
  Else
    CheckSubject = False
  End If

End Function
4

1 に答える 1

1

ループが毎回インクリメントし、同時にスタック () をデクリメントしているため、ループが「途中で」終了していると思われます。そのItemsToProcessため、アイテムの約半分を自然にスキップします。
これを回避するには、次のような方法で上から下にループできます。

For i = ItemsToProcess.Count To 1 Step -1

iMailItems を参照するためのインデックスとして使用します。

于 2012-12-10T22:54:21.887 に答える