Help with Code

[jim may]

Here's my spreadsheet. All outlook data comes back OK EXCEPT Company (Name),, WHY?

See my Code at bottom

Access_Outlook_Data_from_Excel.xls
	A	B	C	D
2		Whatto	Cominginfrom
3	NameinAddressBook	Retrieve	Outlook	STATUS
4	BruceCody	e-mail	bcody@arcwoodva.com	O/K
5		JobTitle	President	O/K
6		Business	(540)989-1040	O/K
7		Home	(540)989-0257	O/K
8		Cell	(540)819-6622	O/K
9		Company	bcody@arcwoodva.com	NOT
10
11
12	StanleyG.Boatwright	e-mail	stan@sgb-cpa.com	O/K
13		JobTitle	Owner	O/K
14		Business	(540)342-6411	O/K
15		Home	(540)774-6732	O/K
16		Cell	(540)354-6732	O/K
17		Company	stan@sgb-cpa.com	NOT
18
19
20	JimMay	e-mail	jmay@jmmay.com	O/K
21		JobTitle	Owner	O/K
22		Business	(540)342-2687	O/K
23		Home	(540)342-2687	O/K
24		Cell	(540)314-3242	O/K
25		Company	jmay@jmmay.com	NOT
Sheet1

Function GetContactInfoFromOutlook(strFullName As String, strReturnItem As String) As String
Dim OLF As Object, olContactItem As Object
Dim OK As Boolean, i As Long, strResult As String
    On Error Resume Next
    Set OLF = GetObject("", "Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(10)
    If OLF Is Nothing Then
        Set OLF = CreateObject("Outlook.Application").GetNamespace("MAPI").GetDefaultFolder(10)
    End If
    On Error GoTo 0
    If Not OLF Is Nothing Then
        With OLF
            OK = False
            i = 0
            Do While i< .Items.Count And Not OK
                i = i + 1
                On Error Resume Next
                Set olContactItem = .Items(i)
                On Error GoTo 0
                If Not olContactItem Is Nothing Then
                    With olContactItem
                        If .FullName = strFullName Then
                            OK = True
                            Select Case LCase(strReturnItem)
                                Case "mail", "e-mail"
                                    strResult = .Email1Address               'OK
                                Case "phone", "home phone", "home"
                                    strResult = .HomeTelephoneNumber         'OK
                                Case "mobile", "cell", "cellphone", "carphone"
                                    strResult = .MobileTelephoneNumber    'OK
                                Case "business"
                                    strResult = .BusinessTelephoneNumber   'OK
                                Case "Job Title"
                                    strResult = .JobTitle                 'OK
                                Case "Company"
                                    strResult = .CompanyName             'NOT WORKING
                                Case "Fax"
                                    strResult = .BusinessFaxNumber      'NOT WORKING - REMOVED
                                Case "job title"
                                    strResult = .JobTitle                 'OK
                                                                ' add more if necessary
                                Case Else ' default result
                                    strResult = .Email1Address
                            End Select
                        End If
                    End With
                    Set olContactItem = Nothing
                End If
            Loop
        End With
        Set OLF = Nothing
    End If
    GetContactInfoFromOutlook = strResult
End Function

 

[jim may]

Never mind - I was not using the "lowercase" in my Case select for Company, as company,,,