2

このサイトで最初に見つけたいくつかのコード (fmunkert、2012) を変更しました。このコードは、最初はセット フォルダー内のアイテム (メール) の数をカウントしていました。

次に、2 つのメッセージ出力を生成します (メッセージ 1: フォルダー内の総メール数、メッセージ 2: 日付のリスト)。

モジュールを修正して、2 つのセット フォルダーをカウントし、それらを 2 つのメッセージのそれぞれの全体的な統計の 1 つのセットに結合します。

これらのフォルダーは 1 年をカバーするので、2 番目のメッセージを制限して、過去 30 日間の日付のみを表示するようにしたいので、これをチェックすると思われる領域を設定しようとしました。

ただし、約3つの日付が乱数を示すのとは別に、1つのアイテムを示すすべての日付を取得します。

私の完全に変更されたコード

Sub InboxEmails()

Dim objOutlook As Object, objnSpace As Object, objFolder As MAPIFolder, objFolder1 As MAPIFolder, objFolder2 As MAPIFolder
Dim EmailCount1 As Integer
Dim EmailCount2 As Integer
Set objOutlook = CreateObject("Outlook.Application")
Set objnSpace = objOutlook.GetNamespace("MAPI")


    ' Verify exisitence of 2013 Actioned / Updated Folder
    On Error Resume Next
    Set objFolder1 = objnSpace.Folders("test@sample.net").Folders("Inbox").Folders("Alico Metlife  Actioned / Updated").Folders("2013 (Actioned / Updated)")
    If Err.Number <> 0 Then
    Err.Clear
    MsgBox "2013 Actioned / Updated Folder Not Found."
    Exit Sub
    End If

    ' Verify exisitence of 2013 IRs Raised Folder
    On Error Resume Next
    Set objFolder2 = objnSpace.Folders("test@sample.net").Folders("Inbox").Folders("Alico MetLife IRs Raised").Folders("2013 (IRs Raised)")
    If Err.Number <> 0 Then
    Err.Clear
    MsgBox "2013 IRs Raised Folder Not Found."
    Exit Sub
    End If


'All folders are present, OK to continue.

EmailCount1 = objFolder1.Items.Count
EmailCount2 = objFolder2.Items.Count

MsgBox "Number of chargeable emails: " & EmailCount1 + EmailCount2

Dim dateStr As String
Dim myItems1 As Outlook.Items
Dim myItems2 As Outlook.Items
Dim dict As Object
Dim msg As String
Set dict = CreateObject("Scripting.Dictionary")
Set myItems1 = objFolder1.Items
Set myItems2 = objFolder2.Items
myItems.SetColumns ("SentOn")


' Determine date of each message:
For Each myItem In myItems1
    dateStr = GetDate(myItem.SentOn)
    If Not dict.Exists(dateStr) Then
        dict(dateStr) = 0
    End If


    dict(dateStr) = CLng(dict(dateStr)) + 1

Next myItem

' Determine date of each message:
For Each myItem In myItems2
    dateStr = GetDate(myItem.SentOn)
    If Not dict.Exists(dateStr) Then
        dict(dateStr) = 0
    End If

    dict(dateStr) = CLng(dict(dateStr)) + 1

Next myItem


' Output counts per day:
msg = ""
For Each o In dict.Keys
    msg = msg & o & ": " & dict(o) & " items" & vbCrLf
Next
MsgBox msg

Set objFolder = Nothing
Set objnSpace = Nothing
Set objOutlook = Nothing
End Sub

試みのバージョン 1

If Not dict.Exists(dateStr >= IsDate(Now) - 30) Then

試みのバージョン 2

If Not dict.Equals(dateStr >= IsDate(Now) - 30) Then

試行バージョン 3

If Not dateStr >= IsDate(Now) - 30 Then

私が変更する必要があるのはこの領域であると確信していますが、私は仕事に取り掛かることができません. これでどこが間違っているのかを知っていただければ幸いです。

編集:私はこれについてさらに調査を行っており、正しい軌道に乗っていることを知っています。これが私の最新のコードです

Dim dateStr As Date
Dim myItems2 As Outlook.Items
Dim dict As Object
Dim msg As String
Dim lastweek As Date
Set dict = CreateObject("Scripting.Dictionary")
Set myItems2 = objFolder2.Items
myItems2.SetColumns ("SentOn")

'Determine date of each message:
For Each myItem In myItems2
dateStr = GetDate(myItem.SentOn)

lastweek = Date
If Not dict.Item(dateStr) >= ((lastweek) - 30) Then
dict.Remove myItems2.myItem
Else

dict(dateStr) = CLng(dict(dateStr)) + 1

End If

Next myItem

各行でウォッチを使用して日付が期待どおりに通過するようにしましたが、これは if ステートメントの else 部分にはまだ行きません。

「dateStr」はアイテムの日付を示し、「(lastweek) - 30」は現在の日付の 30 日前の日付を示します。

これがifステートメントにあるので、日付が30日以内であるステートメントのelse部分に移動することを期待しています。ただし、これは発生しません。理由がわかりません。

参照
fmunkert (2012)、Outlook で日付ごとに電子メールを数える[オンライン] (アクセス 03/2013)

4

2 に答える 2

0

これは、このコードを配置するのに適した場所のようです。日付ごとに受信トレイのアイテムをカウントします。

Sub UserCount()

    ' Put your email, and start date here.
    InboxEmails "user@domain.com", "1/1/2014"

End Sub

Sub InboxEmails(strEmail As String, strStartDate)

    Dim objOutlook As Object, objnSpace As Object, objFolder As MAPIFolder, _
    objDict As Object, strDate As String

    Set objOutlook = CreateObject("Outlook.Application")
    Set objnSpace = objOutlook.GetNamespace("MAPI")
    Set objFolder = objnSpace.Folders(strEmail).Folders("Inbox")

    Set myItems = objFolder.Items
    Set dict = CreateObject("Scripting.Dictionary")

    ' Cache the SentOn column.
    myItems.SetColumns ("SentOn")

    ' Count messages by date.
    For Each myItem In myItems

        ' Only look for emails, other object types do not have a SendOn property.
        If myItem.MessageClass = "IPM.Note" Then

            ' Strip time from datetime.
            dateStr = FormatDateTime(myItem.SentOn, 2)

            ' Only find messages after startDate.
            If CDate(dateStr) > CDate(strStartDate) Then

                    If Not dict.Exists(dateStr) Then
                        dict(dateStr) = 1
                    Else
                        dict(dateStr) = CLng(dict(dateStr)) + 1
                    End If

            End If

        End If

    Next myItem

    ' Print the results to the Immediate Window (Ctrl + G).
    For Each o In dict.Keys
        Debug.Print o & vbTab & dict(o)
    Next

End Sub
于 2014-07-28T15:35:31.647 に答える
0

さて、私はついに自分が間違っていた場所に出くわし、コードのこの行に問題があることがわかりました

If Not dateStr >= ((lastweek) - 30) Then
于 2013-03-12T14:47:59.000 に答える