[[20250219211440]]　『ExcelでOutlookのイベントを補足したい』（がる）　ページの最後に飛ぶ

『ExcelでOutlookのイベントを補足したい』（がる）

 Outlook AdvancedSearchCompleteイベントを補足したいのですが、出来ていません。
Excel VBAで補足したいです。
　ExcelでOutlookのitems listを作成しています。
サブフォルダが多いですが、一括で処理したいです。

　他の方法で出来ましたが、フォルダが固定されていなく、
ソースを短く、修正を最小限にしたいことから、あえてAdvancedSearchを使いたいです。
現在は20秒後に次の処理をさせています。でもそれは…　　スマートじゃないです。
https://learn.microsoft.com/ja-jp/office/vba/api/outlook.application.advancedsearch

Sub OLAdvancedSearch()

    Dim strF As String, date3 As Date, olTB As Table

    Debug.Print
    date3 =  #1/1/2025#
    strF = """DAV:getlastmodified""" & " > '" & Format$(date3, "General Date") & "'"
    Debug.Print strF
    Set olTB = Outlook.Application.AdvancedSearch("'\\abc123@yahoo.co.jp'", strF, True,"Test").GetTable
'###    ###    ###    ###    ###
    Do While blnSearchComp = False
        DoEvents
        Debug.Print blnSearchComp
        stop
    Loop

    Debug.Print olTB.GetRowCount
    Set olTB = Nothing
End Sub

'Outlookイベント補足
Private Sub Application_AdvancedSearchComplete(ByVal SearchObject As Search)

    If SearchObject.Tag = "Test" Then
        blnSearchComp = True
    End If
End Sub

＜使用 Excel：Excel2016、使用 OS：Windows10 ＞

 私自身はOutlookって使った事ないんで、
 あんまり理解してないモンが、しゃしゃり出ても混乱招くだけかもしれませんが・・・ ^^;

 そもそもイベント起こさせるんなら、
 オブジェクトモジュール(ClassとかThisWorkbookとかUserformとか)上でなければ
 動かないと思いますけど、その辺は大丈夫なんでしょうか?

    Rem [ThisWorkbook]--------------------------------------------------------------------------
    Option Explicit
    Public WithEvents OlApp As Outlook.Application
    Private Sub OlApp_AdvancedSearchComplete(ByVal SearchObject As Search)
        Debug.Print Now; SearchObject.Tag
        If SearchObject.Tag = "Test" Then
            blnSearchComp = True
        End If
    End Sub

    Rem [Module1]-------------------------------------------------------------------------------
    Option Explicit
    Public Declare PtrSafe Sub Sleep Lib "KERNEL32.dll" (ByVal dwMilliseconds As Long)
    Public blnSearchComp As Boolean
    Sub OLAdvancedSearch()
        Dim strF As String, date3 As Date, olTB As Outlook.Table
        Debug.Print
        date3 = #1/1/2025#
        'strF = """DAV:getlastmodified""" & " > '" & Format$(date3, "General Date") & "'"
        strF = "DAV:getlastmodified" & " > '" & Format$(date3, "General Date") & "'"
        Debug.Print strF
        'Set olTB = Outlook.Application.AdvancedSearch("'\\abc123@yahoo.co.jp'", strF, True,"Test").GetTable
        Set ThisWorkbook.OlApp = New Outlook.Application
        With ThisWorkbook.OlApp.AdvancedSearch("Inbox", strF, True, "Test")
            Set olTB = .GetTable
        End With
    '###    ###    ###    ###    ###
        Do While blnSearchComp = False
            DoEvents
            Debug.Print blnSearchComp
            Sleep 100
        Loop
        Debug.Print olTB.GetRowCount
        Set olTB = Nothing
        ThisWorkbook.OlApp.Quit
        Set ThisWorkbook.OlApp = Nothing
    End Sub

（白茶） 2025/02/20(木) 09:43:09

　白茶さん、早速の回答ありがとうございます。提示されたソースで解決しました。
しかし、安定しないです。時には無限ループに入ってしまうことがあります。
無限ループは強制exitで対処しようと思います。

Private Sub OlApp_AdvancedSearchComplete(ByVal SearchObject As Search)
"OlApp_"　ココ重要なのですね。何も考えずに書いていました。
使い方がさっぱり分かりませんが、頑張って調べてみます。
ホントはヒントがホッシィです。
（がる） 2025/02/20(木) 21:45:27

解決 WithEvents を新たに習得できました。
ありがとうございます。
（ごう） 2025/02/27(木) 08:00:20

コメント返信：

[ 一覧(最新更新順) ]

[[20250219211440]] 『ExcelでOutlookのイベントを補足したい』（がる） ページの最後に飛ぶ

[[20250219211440]]　『ExcelでOutlookのイベントを補足したい』（がる）　ページの最後に飛ぶ