Retrieving data from Outlook's ContactItem. Works in Outlook, fails in Excel

[wiseleo]

Good evening,

This code basically runs an AdvancedSearch in Outlook 2003.

When launched from Outlook, it runs successfully.
When launched from Excel, it actually outputs "AdvancedSearchComplete even fired" in Outlook's (not Excel's) Immediate window and then gets stuck in DoEvents loop.
The end goal is to be able to manipulate the results of AdvancedSearch in Excel.

Outlook Code from ThisOutlookSession


[vba]
Public blnSearchComp As Boolean
Private Sub Application_AdvancedSearchComplete(ByVal SearchObject As Search)
Debug.Print "The AdvancedSearchComplete Event fired"
blnSearchComp = True
End Sub
Sub TestAdvancedSearchComplete()
Dim sch As Outlook.Search
Dim rsts As Outlook.Results
Dim i As Integer
blnSearchComp = False
Const strS As String = "'\\Business Contact Manager\Business Contacts'"
Set sch = Application.AdvancedSearch(strS, strF)
While blnSearchComp = False
DoEvents
Wend
Set rsts = sch.Results
For i = 1 To rsts.Count
Debug.Print rsts.Item(i).CompanyName; _
" - "; rsts.Item(i).FullName; vbCr;
Next
End Sub
[/vba]

Excel code in ThisExcelSession
[vba]Dim WithEvents olApp As Outlook.Application
Public blnSearchComp As Boolean
Private Sub olApp_AdvancedSearchComplete(ByVal SearchObject As Outlook.Search)
Debug.Print "The AdvancedSearchComplete Event fired"
blnSearchComp = True
End Sub
Sub TestAdvancedSearchComplete()
Dim sch As Outlook.Search
Dim rsts As Outlook.Results
Dim i As Integer
blnSearchComp = False
Const strS As String = "'\\Business Contact Manager\Business Contacts'"
Set sch = Outlook.AdvancedSearch(strS, strF)
While blnSearchComp = False
DoEvents
Wend
Set rsts = sch.Results
For i = 1 To rsts.Count
Debug.Print rsts.Item(i).CompanyName; _
" - "; rsts.Item(i).FullName; vbCr;
Next
End Sub[/vba]

I am running into a brick wall trying to figure out how to get the code to execute correctly.

Thank you very much.

[Andy Pope]

Not sure but if the debug.print is outputting to the Outlook immediate window I would have thought the code in outlook was executing rather than that which is in Excel.
Is that outlook code still in outlook?

Standard code module

Public g_clsTest As Class1

Sub TestAdvancedSearchComplete()
    
    Dim strF As String
    Const strS As String = "'\\Business Contact Manager\Business Contacts'"
    
    Set g_clsTest = New Class1
    
    
    g_clsTest.AdvSearch strS, strF

End Sub

Class code Class1

Public WithEvents olApp As Outlook.Application
Private m_sch As Outlook.Search
Public Sub AdvSearch(MyScope As String, MyFilter As String)

    Set m_sch = olApp.AdvancedSearch(MyScope, MyFilter)
    
End Sub
Private Sub Class_Initialize()

    Set Me.olApp = CreateObject("Outlook.application")
    
End Sub
Private Sub Class_Terminate()

    Set Me.olApp = Nothing
    
End Sub
Private Sub olApp_AdvancedSearchComplete(ByVal SearchObject As Outlook.Search)

    Dim rsts As Outlook.Results
    Dim i
    
    Set rsts = m_sch.Results
    For i = 1 To rsts.Count
        Debug.Print rsts.Item(i).CompanyName; _
        " - "; rsts.Item(i).FullName; vbCr;
    Next

End Sub

The above uses a class object to trigger and capture the advance search.

[mvidas]

I would guess it is showing up in the outlook immediate window since your event code is still in outlook vba, as Andy is suggesting.

Where are you assigning olApp ?

[vba]Sub TestAdvancedSearchComplete()
Dim sch As Outlook.Search
Dim rsts As Outlook.Results
Dim i As Integer
Set olApp = CreateObject("outlook.application") '********** added
blnSearchComp = False
Const strS As String = "'\\Business Contact Manager\Business Contacts'"
Set sch = olApp.AdvancedSearch(strS, strF) '********** changed
While blnSearchComp = False
DoEvents
Wend
Set rsts = sch.Results
For i = 1 To rsts.Count
Debug.Print rsts.Item(i).CompanyName; _
" - "; rsts.Item(i).FullName; vbCr;
Next
Set olApp = Nothing '********** added
End Sub[/vba]

[wiseleo]

Thanks for your help.

Andy's code runs, although it appears to not terminate all instances of Outlook.exe (although that could be due to ActiveSync sitting in the tray, and doesn't matter much anyway), and thank you mvidas for explaining what was wrong. It looks like I needed to create a new instance of the class and I'd be OK.

Now I'll be having some fun coming up with the correct strings for strF :-) but this was the hard part.

Thank you

[wiseleo]

The code works and loops through the A column of cells, but I can't seem to make it loop through output. I know I am missing something silly.

I did finally get the strF input string to work. That was a major pain to construct, but everyone is welcome to use it.

What I am trying to do is parse values in column A, and output the relevant output in column E of the same row.

I've tried using range offset, but for whatever reason I can't seem to use it properly.

Class Module:

[vba]Public WithEvents olApp As Outlook.Application
Private m_sch As Outlook.Search
Public Sub AdvSearch(MyScope As String, MyFilter As String)
Set m_sch = olApp.AdvancedSearch(MyScope, MyFilter)
End Sub
Private Sub Class_Initialize()
Set Me.olApp = CreateObject("Outlook.Application")
End Sub
Private Sub Class_Terminate()
Set Me.olApp = Nothing
End Sub
Private Sub olApp_AdvancedSearchComplete(ByVal SearchObject As Outlook.Search)
Dim rsts As Outlook.Results
Dim i As Integer
i = 1
Set rsts = m_sch.Results
If rsts.Count < 1 Then
MsgBox "No match"
Debug.Print "No match"
End If
If rsts.Count = 1 Then
Excel.Range("E1") = rsts.Item(i).CompanyName & _
" - " & rsts.Item(i).FullName & " - " & Excel.Range("A1")
Debug.Print "Exact user"
End If
If rsts.Count > 1 Then
Excel.Range("E1") = rsts.Item(i).CompanyName & _
" - " & Excel.Range("A1")
Debug.Print "Multiple matches"
End If
' For i = 1 To rsts.Count
' Excel.Range("E1") = rsts.Item(i).CompanyName & _
' " - " & rsts.Item(i).FullName & " - " & Excel.Range("A1")
' Debug.Print rsts.Item(i).CompanyName; _
' " - "; rsts.Item(i).FullName; "test"
' Next
End Sub
[/vba]

Code module:

[vba]Public g_clsTest As OlAdvSearch
Sub LookupPhoneNumber()
Dim strF As String
Dim strT As String
strT = Excel.Range("A1")
'strT = InputBox("Enter portion of the phone number", "Search Criteria") // Inputbox
'strF = "urn:schemas:contacts:organizationmainphone LIKE '%" & strT & "%'" //works
'strF = LCase$("urn:schemas:contacts:organizationmainphone LIKE '%" & strT & "%'") _
'& " Or " & LCase$("urn:schemas:contacts:officetelephonenumber LIKE '%" & strT & "%'")
'// Works

strF = "httpREMOVETHIS://schemas.microsoft.com/mapi/proptag/0x3a1a001f Like " & "'%" & strT & "%'" _
& " OR " & "urn:schemas:contacts:officetelephonenumber Like " & "'%" & strT & "%'" _
& " OR " & "urn:schemas:contacts:office2telephonenumber Like " & "'%" & strT & "%'" _
& " OR " & "urn:schemas:contacts:homePhone Like " & "'%" & strT & "%'" _
& " OR " & "urn:schemas:contacts:homephone2 Like " & "'%" & strT & "%'" _
& " OR " & "httpREMOVETHIS://schemas.microsoft.com/mapi/proptag/0x3a1c001fLike Like " & "'%" & strT & "%'" _
& " OR " & "urn:schemas:contacts:othermobile Like " & "'%" & strT & "%'" _
& " OR " & "urn:schemas:contacts:callbackphone Like " & "'%" & strT & "%'" _
& " OR " & "urn:schemas:contactsager Like " & "'%" & strT & "%'" _
& " OR " & "httpREMOVETHIS://schemas.microsoft.com/mapi/proptag/0x3a1d001f Like " & "'%" & strT & "%'" _
& " OR " & "urn:schemas:contacts:secretaryphone Like " & "'%" & strT & "%'" _
& " OR " & "urn:schemas:contacts:otherTelephone Like " & "'%" & strT & "%'" _
& " OR " & "urn:schemas:contacts:organizationmainphone Like " & "'%" & strT & "%'" _
& " OR " & "urn:schemas:contacts:telexnumber Like " & "'%" & strT & "%'" _
& " OR " & "urn:schemas:contacts:internationalisdnnumber Like " & "'%" & strT & "%'" _
& " OR " & "urn:schemas:contacts:ttytddphone Like " & "'%" & strT & "%'"

Const strS As String = "'\\Business Contact Manager\Business Contacts'"
Excel.Range("B1") = strF
Set g_clsTest = New OlAdvSearch
g_clsTest.AdvSearch strS, strF
'Debug.Print "End TestAdvancedSearchComplete"
End Sub
[/vba]

I've left comments in for some debugging stuff I've used.

The B1 cell was there for debug purposes to output the filter string. The Msgbox call was also for debug purposes.

Thank you very much for your help.

[wiseleo]

Hi everyone,

Perhaps a little help?

Thank you.