エクセルVBAは、送信者が、キーワードによって

Question

ソリューションを電子メールでキーワードをカウント：

Option Compare Text 

Sub Count_Emails() 

Dim oNS As Outlook.Namespace 
Dim oTaskFolder As Outlook.MAPIFolder 
Dim oItems As Outlook.Items 
Dim oFoldToSearch As Object 
Dim intCounter As Integer 
Dim oWS As Worksheet 
Dim dStartDate, dEnddate As Date 
Dim CharityBG, CureBG, PartySJ, WooWooSJ As Integer 

Set oWS = Sheets("Sheet1") 
Set oNS = GetNamespace("MAPI") 
Set oTaskFolder = oNS.Folders("bill.gates@microsoft.com") 
Set oFoldToSearch = oTaskFolder.Folders("Inbox").Folders("New Folder") 
Set oItems = oFoldToSearch.Items 

intCounter = 1 
dStartDate = oWS.Range("A1").Value 
dEnddate = oWS.Range("B1").Value 

Do 

    With oWS 

     If DateSerial(Year(oItems(intCounter).ReceivedTime), Month(oItems(intCounter).ReceivedTime), Day(oItems(intCounter).ReceivedTime)) >= dStartDate And _ 
      DateSerial(Year(oItems(intCounter).ReceivedTime), Month(oItems(intCounter).ReceivedTime), Day(oItems(intCounter).ReceivedTime)) <= dEnddate And _ 
      oItems(intCounter).Subject Like "*Charity Work*" And oItems(intCounter).SenderName = "Bill Gates" Then 
      CharityBG = CharityBG + 1 
     End If 
     If DateSerial(Year(oItems(intCounter).ReceivedTime), Month(oItems(intCounter).ReceivedTime), Day(oItems(intCounter).ReceivedTime)) >= dStartDate And _ 
      DateSerial(Year(oItems(intCounter).ReceivedTime), Month(oItems(intCounter).ReceivedTime), Day(oItems(intCounter).ReceivedTime)) <= dEnddate And _ 
      oItems(intCounter).Subject Like "*Curing Malaria*" And oItems(intCounter).SenderName = "Bill Gates" Then 
      CureBG = CureBG + 1 
     End If 

     If DateSerial(Year(oItems(intCounter).ReceivedTime), Month(oItems(intCounter).ReceivedTime), Day(oItems(intCounter).ReceivedTime)) >= dStartDate And _ 
      DateSerial(Year(oItems(intCounter).ReceivedTime), Month(oItems(intCounter).ReceivedTime), Day(oItems(intCounter).ReceivedTime)) <= dEnddate And _ 
      oItems(intCounter).Subject Like "*Ghost Party*" And oItems(intCounter).SenderName = "Steve Jobs" Then 
      PartySJ = PartySJ + 1 
     End If 
     If DateSerial(Year(oItems(intCounter).ReceivedTime), Month(oItems(intCounter).ReceivedTime), Day(oItems(intCounter).ReceivedTime)) >= dStartDate And _ 
      DateSerial(Year(oItems(intCounter).ReceivedTime), Month(oItems(intCounter).ReceivedTime), Day(oItems(intCounter).ReceivedTime)) <= dEnddate And _ 
      oItems(intCounter).Subject Like "*WoooOOOooo*" And oItems(intCounter).SenderName = "Steve Jobs" Then 
      WooWooSJ = WooWooSJ + 1 
     End If 

    End With 

    intCounter = intCounter + 1 

Loop Until intCounter >= oItems.Count + 1 

Set oNS = Nothing 
Set oTaskFolder = Nothing 
Set oAutomation = Nothing 
Set oItems = Nothing 
oWS.Range("A2").Value = CharityBG 
oWS.Range("A3").Value = CureBG 
oWS.Range("B2").Value = PartySJ 
oWS.Range("B3").Value = WooWooSJ 

End Sub 

質問：私は、メールボックスのフォルダを見エクセルVBAスクリプトを作成している

、 2つのExcelセルの日付範囲を使用し、送信者と一致する電子メールを検索し、件名にキーワードを探し、出現を集計してExcelセルに書き込みます。

問題は、電子メールアドレスを条件の1つとして使用する場合に発生します。キーワードを探しているだけの場合は、送信者を指定せずに動作します。送信者とキーワードを実行しようとすると、0が返されます。代わりにMailItem.SenderEmailAddressを試すと、10の値が返されます。私は間違って何をしていますか？

Option Compare Text 

Sub HowManyDatedEmailsv2() 
Dim objOutlook As Object, objnSpace As Object, objFolder As Object 
Dim EmailCount As Integer 
Set objOutlook = CreateObject("Outlook.Application") 
Set objnSpace = objOutlook.GetNameSpace("MAPI") 

    On Error Resume Next 
    Set objFolder = objnSpace.Folders("\\Email Address 1\\").Folders("Inbox").Folders("Enquiries") 
    Set myItems = objFolder.Items.Restrict("[SenderEmailAddress] <> '\\Email Address 2\\'") 
    If Err.Number <> 0 Then 
    Err.Clear 
    MsgBox "No such folder." 
    Exit Sub 
    End If 

Dim iCount, OnlineAT, CallinAT As Integer 
Dim myDate1, myDate2 As Date 
EmailCount = myItems.Count 
OnlineAT = 0 
CallinAT = 0 
myDate1 = Sheets("Sheet1").Range("C5").Value 
myDate2 = Sheets("Sheet1").Range("C6").Value 
For iCount = 1 To EmailCount 
With objFolder.Items(iCount) 
    If DateSerial(Year(.ReceivedTime), Month(.ReceivedTime), Day(.ReceivedTime)) >= myDate1 And _ 
     DateSerial(Year(.ReceivedTime), Month(.ReceivedTime), Day(.ReceivedTime)) <= myDate2 And _ 
     SenderEmailAddress = "\\Email Address 1\\" And .Subject Like "*~Online*" Then 
     OnlineAT = OnlineAT + 1 
    End If 
    If DateSerial(Year(.ReceivedTime), Month(.ReceivedTime), Day(.ReceivedTime)) >= myDate1 And _ 
     DateSerial(Year(.ReceivedTime), Month(.ReceivedTime), Day(.ReceivedTime)) <= myDate2 And _ 
     SenderEmailAddress = "\\Email Address 1\\" And .Subject Like "*~Callin*" Then 
     CallinAT = CallinAT + 1 
    End If 
    End With 
Next iCount 

Set objFolder = Nothing 
Set objnSpace = Nothing 
Set objOutlook = Nothing 
Sheets("Summary").Range("C12").Value = OnlineAT 
Sheets("Summary").Range("C13").Value = CallinAT 

End Sub 

Answer 1

あなたが「SenderEmailAddress」を設定しているが、私はそれで簡単に行くOutlookの参照（Microsoft Outlook 15.0 Object Library）を使用していたところ、私が見ることができません。そのあなたがしようとするものに類似して

Sub GetEmailDetails(ByVal strFolder) 

    Dim oNS As Outlook.Namespace 
    Dim oTaskFolder As Outlook.MAPIFolder 
    Dim oItems As Outlook.Items 
    Dim oFoldToSearch As Object 
    Dim intCounter, intX As Integer 
    Dim oWS As Worksheet: Set oWS = Worksheets(1) 
    Dim dStartDate, dEnddate As Date 
    Dim strSenderName As String 

    Set oNS = GetNamespace("MAPI") 
    Set oTaskFolder = oNS.GetDefaultFolder(olFolderInbox) 
    Set oFoldToSearch = oTaskFolder.Folders(strFolder) 
    Set oItems = oFoldToSearch.Items 

    intCounter = 1 
    intX = 2 
    dStartDate = oWS.Cells(24, 3).Value 
    dEnddate = oWS.Cells(25, 3).Value 
    strSenderName = oWS.Cells(26, 3).Value 
    Do 

     With oWS 

      ' If you wanted to check via email address and not the sender name, you can use this code 
      'Dim strSenderEmail As String 
      'If oItems(intCounter).SenderEmailType = "EX" Then 
      ' strSenderEmail = oItems(intCounter).Sender.GetExchangeUser.PrimarySmtpAddress 
      'Else 
      ' strSenderEmail = oItems(intCounter).SenderEmailAddress 
      'End If 

      If DateSerial(Year(oItems(intCounter).ReceivedTime), Month(oItems(intCounter).ReceivedTime), Day(oItems(intCounter).ReceivedTime)) >= dStartDate And _ 
       DateSerial(Year(oItems(intCounter).ReceivedTime), Month(oItems(intCounter).ReceivedTime), Day(oItems(intCounter).ReceivedTime)) <= dEnddate And _ 
       oItems(intCounter).Subject Like "*Training Session*" And oItems(intCounter).SenderName = strSenderName Then 

       .Cells(intX, 1).Value = oItems(intCounter).CreationTime 
       .Cells(intX, 2).Value = oItems(intCounter).ReceivedTime 
       .Cells(intX, 3).Value = oItems(intCounter).Subject 
       .Cells(intX, 4).Value = oItems(intCounter).SenderName 
       .Cells(intX, 5).Value = oItems(intCounter).SenderEmailAddress 
       .Cells(intX, 6).Value = oItems(intCounter).CC 
       .Cells(intX, 7).Value = oItems(intCounter).SenderEmailType 
       '.Cells(intX, 8).Value = oItems(intCounter).Body 

       intX = intX + 1 

      End If 

     End With 

     intCounter = intCounter + 1 

    Loop Until intCounter >= oItems.Count + 1 

    Set oNS = Nothing 
    Set oTaskFolder = Nothing 
    Set oAutomation = Nothing 
    Set oItems = Nothing 

End Sub 

予想通り、私は、カウントを取得することができます私はあなたがこのオブジェクトとへのアクセス権を持っている項目の一部を残しています。これが役に立ちますようにお願いします。