I have a userform with a combo box, i am trying to get the combobox to
display external data from outlook, objcontacts. I have no idea how to
achieve this, please help.

Hi Oggy,

Try something like:

'=============>>
Private Sub UserForm_Initialize()
Dim olApp As Outlook.Application
Dim oContact As Outlook.ContactItem
Dim oContactFolder As Outlook.MAPIFolder
Dim oContactItems As Outlook.Items
Dim oNS As Outlook.NameSpace
Dim i As Long

Me.ComboBox1.Clear

On Error GoTo XIT
Set olApp = New Outlook.Application
Set oNS = olApp.GetNamespace("MAPI")
Set oContactFolder = oNS.GetDefaultFolder(olFolderContacts)
Set oContactItems = oContactFolder.Items

For i = 1 To oContactItems.Count
If oContactItems.Item(i).Class = olContact Then
Set oContact = oContactItems.Item(i)
Me.ComboBox1.AddItem oContact.FullName
End If
Next
Me.ComboBox1.ListIndex = 0

XIT:
Set oContact = Nothing
Set oContactItems = Nothing
Set oContactFolder = Nothing
Set oNS = Nothing
Set olApp = Nothing
End Sub
'<<=============


Set a reference to the Microsoft Outlook xx Object Library:

In the VBE,

Tools | References| Locate and select the library.


---
Regards,
Norman



"Oggy" <(E-Mail Removed)> wrote in message
news:(E-Mail Removed)...
>I have a userform with a combo box, i am trying to get the combobox to
> display external data from outlook, objcontacts. I have no idea how to
> achieve this, please help.
>

Thanks Norman, it work perfect. I lost sleep on this!

can you please advise me how to add there address and telephone numbers


Many thanks again

Regards
Oggy



Norman Jones wrote:
> Hi Oggy,
>
> Try something like:
>
> '=============>>
> Private Sub UserForm_Initialize()
> Dim olApp As Outlook.Application
> Dim oContact As Outlook.ContactItem
> Dim oContactFolder As Outlook.MAPIFolder
> Dim oContactItems As Outlook.Items
> Dim oNS As Outlook.NameSpace
> Dim i As Long
>
> Me.ComboBox1.Clear
>
> On Error GoTo XIT
> Set olApp = New Outlook.Application
> Set oNS = olApp.GetNamespace("MAPI")
> Set oContactFolder = oNS.GetDefaultFolder(olFolderContacts)
> Set oContactItems = oContactFolder.Items
>
> For i = 1 To oContactItems.Count
> If oContactItems.Item(i).Class = olContact Then
> Set oContact = oContactItems.Item(i)
> Me.ComboBox1.AddItem oContact.FullName
> End If
> Next
> Me.ComboBox1.ListIndex = 0
>
> XIT:
> Set oContact = Nothing
> Set oContactItems = Nothing
> Set oContactFolder = Nothing
> Set oNS = Nothing
> Set olApp = Nothing
> End Sub
> '<<=============
>
>
> Set a reference to the Microsoft Outlook xx Object Library:
>
> In the VBE,
>
> Tools | References| Locate and select the library.
>
>
> ---
> Regards,
> Norman
>
>
>
> "Oggy" <(E-Mail Removed)> wrote in message
> news:(E-Mail Removed)...
> >I have a userform with a combo box, i am trying to get the combobox to
> > display external data from outlook, objcontacts. I have no idea how to
> > achieve this, please help.
> >

Hi Oggy,

Perhaps try adding a ListBox and try something like:

'=============>>
Private Sub UserForm_Initialize()
Dim olApp As Outlook.Application
Dim oContact As Outlook.ContactItem
Dim oContactFolder As Outlook.MAPIFolder
Dim oContactItems As Outlook.Items
Dim oNS As Outlook.NameSpace
Dim i As Long
Dim j As Long
Dim arr()

With Me.ListBox1
.ColumnCount = 3
.ColumnWidths = "90 pt;72 pt;90 pt"
.TextColumn = -1
End With

On Error GoTo XIT
Set olApp = New Outlook.Application
Set oNS = olApp.GetNamespace("MAPI")
Set oContactFolder = oNS.GetDefaultFolder(olFolderContacts)
Set oContactItems = oContactFolder.Items

With Me
For i = 1 To oContactItems.Count
If oContactItems.Item(i).Class = olContact Then
Set oContact = oContactItems.Item(i)
j = j + 1
ReDim Preserve arr(0 To 2, 1 To j)
With oContact
arr(0, j) = .FullName
arr(1, j) = .HomeAddress
arr(2, j) = .HomeTelephoneNumber
End With
End If
Next i

Me.ListBox1.List() = Application.Transpose(arr)

End With

XIT:
Set oContact = Nothing
Set oContactItems = Nothing
Set oContactFolder = Nothing
Set oNS = Nothing
Set olApp = Nothing
End Sub
'<<=============

--
---
Regards,
Norman



"Oggy" <(E-Mail Removed)> wrote in message
news:(E-Mail Removed)...
> Thanks Norman, it work perfect. I lost sleep on this!
>
> can you please advise me how to add there address and telephone numbers
>
>
> Many thanks again
>
> Regards
> Oggy
>
>
>
> Norman Jones wrote:
>> Hi Oggy,
>>
>> Try something like:
>>
>> '=============>>
>> Private Sub UserForm_Initialize()
>> Dim olApp As Outlook.Application
>> Dim oContact As Outlook.ContactItem
>> Dim oContactFolder As Outlook.MAPIFolder
>> Dim oContactItems As Outlook.Items
>> Dim oNS As Outlook.NameSpace
>> Dim i As Long
>>
>> Me.ComboBox1.Clear
>>
>> On Error GoTo XIT
>> Set olApp = New Outlook.Application
>> Set oNS = olApp.GetNamespace("MAPI")
>> Set oContactFolder = oNS.GetDefaultFolder(olFolderContacts)
>> Set oContactItems = oContactFolder.Items
>>
>> For i = 1 To oContactItems.Count
>> If oContactItems.Item(i).Class = olContact Then
>> Set oContact = oContactItems.Item(i)
>> Me.ComboBox1.AddItem oContact.FullName
>> End If
>> Next
>> Me.ComboBox1.ListIndex = 0
>>
>> XIT:
>> Set oContact = Nothing
>> Set oContactItems = Nothing
>> Set oContactFolder = Nothing
>> Set oNS = Nothing
>> Set olApp = Nothing
>> End Sub
>> '<<=============
>>
>>
>> Set a reference to the Microsoft Outlook xx Object Library:
>>
>> In the VBE,
>>
>> Tools | References| Locate and select the library.
>>
>>
>> ---
>> Regards,
>> Norman
>>
>>
>>
>> "Oggy" <(E-Mail Removed)> wrote in message
>> news:(E-Mail Removed)...
>> >I have a userform with a combo box, i am trying to get the combobox to
>> > display external data from outlook, objcontacts. I have no idea how to
>> > achieve this, please help.
>> >
>

Hi Norman, You are brilliant, it works a treat. can this be done in a
combobox. What i am trying to achieve is search for a name (the
combobox lists as you enter the letters) and see the address on my
selection then upon selection enter it into excel speadsheet.

Sorry to be a pain, i owe you a drink

regards

Oggy



Norman Jones wrote:
> Hi Oggy,
>
> Perhaps try adding a ListBox and try something like:
>
> '=============>>
> Private Sub UserForm_Initialize()
> Dim olApp As Outlook.Application
> Dim oContact As Outlook.ContactItem
> Dim oContactFolder As Outlook.MAPIFolder
> Dim oContactItems As Outlook.Items
> Dim oNS As Outlook.NameSpace
> Dim i As Long
> Dim j As Long
> Dim arr()
>
> With Me.ListBox1
> .ColumnCount = 3
> .ColumnWidths = "90 pt;72 pt;90 pt"
> .TextColumn = -1
> End With
>
> On Error GoTo XIT
> Set olApp = New Outlook.Application
> Set oNS = olApp.GetNamespace("MAPI")
> Set oContactFolder = oNS.GetDefaultFolder(olFolderContacts)
> Set oContactItems = oContactFolder.Items
>
> With Me
> For i = 1 To oContactItems.Count
> If oContactItems.Item(i).Class = olContact Then
> Set oContact = oContactItems.Item(i)
> j = j + 1
> ReDim Preserve arr(0 To 2, 1 To j)
> With oContact
> arr(0, j) = .FullName
> arr(1, j) = .HomeAddress
> arr(2, j) = .HomeTelephoneNumber
> End With
> End If
> Next i
>
> Me.ListBox1.List() = Application.Transpose(arr)
>
> End With
>
> XIT:
> Set oContact = Nothing
> Set oContactItems = Nothing
> Set oContactFolder = Nothing
> Set oNS = Nothing
> Set olApp = Nothing
> End Sub
> '<<=============
>
> --
> ---
> Regards,
> Norman
>
>
>
> "Oggy" <(E-Mail Removed)> wrote in message
> news:(E-Mail Removed)...
> > Thanks Norman, it work perfect. I lost sleep on this!
> >
> > can you please advise me how to add there address and telephone numbers
> >
> >
> > Many thanks again
> >
> > Regards
> > Oggy
> >
> >
> >
> > Norman Jones wrote:
> >> Hi Oggy,
> >>
> >> Try something like:
> >>
> >> '=============>>
> >> Private Sub UserForm_Initialize()
> >> Dim olApp As Outlook.Application
> >> Dim oContact As Outlook.ContactItem
> >> Dim oContactFolder As Outlook.MAPIFolder
> >> Dim oContactItems As Outlook.Items
> >> Dim oNS As Outlook.NameSpace
> >> Dim i As Long
> >>
> >> Me.ComboBox1.Clear
> >>
> >> On Error GoTo XIT
> >> Set olApp = New Outlook.Application
> >> Set oNS = olApp.GetNamespace("MAPI")
> >> Set oContactFolder = oNS.GetDefaultFolder(olFolderContacts)
> >> Set oContactItems = oContactFolder.Items
> >>
> >> For i = 1 To oContactItems.Count
> >> If oContactItems.Item(i).Class = olContact Then
> >> Set oContact = oContactItems.Item(i)
> >> Me.ComboBox1.AddItem oContact.FullName
> >> End If
> >> Next
> >> Me.ComboBox1.ListIndex = 0
> >>
> >> XIT:
> >> Set oContact = Nothing
> >> Set oContactItems = Nothing
> >> Set oContactFolder = Nothing
> >> Set oNS = Nothing
> >> Set olApp = Nothing
> >> End Sub
> >> '<<=============
> >>
> >>
> >> Set a reference to the Microsoft Outlook xx Object Library:
> >>
> >> In the VBE,
> >>
> >> Tools | References| Locate and select the library.
> >>
> >>
> >> ---
> >> Regards,
> >> Norman
> >>
> >>
> >>
> >> "Oggy" <(E-Mail Removed)> wrote in message
> >> news:(E-Mail Removed)...
> >> >I have a userform with a combo box, i am trying to get the combobox to
> >> > display external data from outlook, objcontacts. I have no idea how to
> >> > achieve this, please help.
> >> >
> >

Hi Oggy,

Retaining the ListBox, add a CommandButton and the
following code:

'=============>>
Private Sub CommandButton1_Click()
Dim SH As Worksheet
Dim destRng As Range

Set SH = ThisWorkbook.Sheets("Sheet1") '<<=== CHANGE

Set destRng = SH.Range("A" & Rows.Count).End(xlUp)(2)
With Me.ListBox1
destRng.Value = .List(.ListIndex, 0)
destRng(1, 2).Value = .List(.ListIndex, 1)
destRng(1, 2).Value = .List(.ListIndex, 2)
End With
End Sub
'<<=============

---
Regards,
Norman



"Oggy" <(E-Mail Removed)> wrote in message
news:(E-Mail Removed)...
> Hi Norman, You are brilliant, it works a treat. can this be done in a
> combobox. What i am trying to achieve is search for a name (the
> combobox lists as you enter the letters) and see the address on my
> selection then upon selection enter it into excel speadsheet.
>
> Sorry to be a pain, i owe you a drink
>
> regards
>
> Oggy

Hi Norman,

Many thanks for all help, that worked a treat, its very clever stuff.
I have alot of contacts split up by catogerys. Is there a way i can
pull in the outlook contacts by catogery so that i am not loading all
of my contacts.


Many thanks again

Regards

Ian

Norman Jones wrote:
> Hi Oggy,
>
> Retaining the ListBox, add a CommandButton and the
> following code:
>
> '=============>>
> Private Sub CommandButton1_Click()
> Dim SH As Worksheet
> Dim destRng As Range
>
> Set SH = ThisWorkbook.Sheets("Sheet1") '<<=== CHANGE
>
> Set destRng = SH.Range("A" & Rows.Count).End(xlUp)(2)
> With Me.ListBox1
> destRng.Value = .List(.ListIndex, 0)
> destRng(1, 2).Value = .List(.ListIndex, 1)
> destRng(1, 2).Value = .List(.ListIndex, 2)
> End With
> End Sub
> '<<=============
>
> ---
> Regards,
> Norman
>
>
>
> "Oggy" <(E-Mail Removed)> wrote in message
> news:(E-Mail Removed)...
> > Hi Norman, You are brilliant, it works a treat. can this be done in a
> > combobox. What i am trying to achieve is search for a name (the
> > combobox lists as you enter the letters) and see the address on my
> > selection then upon selection enter it into excel speadsheet.
> >
> > Sorry to be a pain, i owe you a drink
> >
> > regards
> >
> > Oggy

Hi Oggy,

'---------------
I have alot of contacts split up by catogerys. Is there a way i can
pull in the outlook contacts by catogery so that i am not loading all
of my contacts.

'---------------

Try something like:

'=============>>
Private Sub UserForm_Initialize()
Dim olApp As Outlook.Application
Dim oContact As Outlook.ContactItem
Dim oContactFolder As Outlook.MAPIFolder
Dim oContactItems As Outlook.Items
Dim oNS As Outlook.NameSpace
Dim i As Long
Dim j As Long
Dim arr()

With Me.ListBox1
.ColumnCount = 3
.ColumnWidths = "90 pt;72 pt;90 pt"
.TextColumn = -1
.MultiSelect = fmMultiSelectSingle
End With

On Error GoTo XIT
Set olApp = New Outlook.Application
Set oNS = olApp.GetNamespace("MAPI")
Set oContactFolder = oNS.GetDefaultFolder(olFolderContacts)
Set oContactItems = oContactFolder.Items

With Me
For i = 1 To oContactItems.Count
If oContactItems.Item(i).Class = olContact Then
Set oContact = oContactItems.Item(i)
If oContact.Categories = "Personal" Then '<<=== CHANGE
j = j + 1
ReDim Preserve arr(0 To 2, 1 To j)
With oContact
arr(0, j) = .FullName
arr(1, j) = .HomeAddress
arr(2, j) = .HomeTelephoneNumber
End With
End If
End If
Next i

Me.ListBox1.List() = Application.Transpose(arr)

End With

XIT:
Set oContact = Nothing
Set oContactItems = Nothing
Set oContactFolder = Nothing
Set oNS = Nothing
Set olApp = Nothing
End Sub
'<<=============


---
Regards,
Norman

Thanks Norman you have done it again!

One final thing, then i promise to leave you alone, When i pull in the
address i get the carriage return characters, how do i get rid of them?

Regards

Oggy


Norman Jones wrote:
> Hi Oggy,
>
> '---------------
> I have alot of contacts split up by catogerys. Is there a way i can
> pull in the outlook contacts by catogery so that i am not loading all
> of my contacts.
>
> '---------------
>
> Try something like:
>
> '=============>>
> Private Sub UserForm_Initialize()
> Dim olApp As Outlook.Application
> Dim oContact As Outlook.ContactItem
> Dim oContactFolder As Outlook.MAPIFolder
> Dim oContactItems As Outlook.Items
> Dim oNS As Outlook.NameSpace
> Dim i As Long
> Dim j As Long
> Dim arr()
>
> With Me.ListBox1
> .ColumnCount = 3
> .ColumnWidths = "90 pt;72 pt;90 pt"
> .TextColumn = -1
> .MultiSelect = fmMultiSelectSingle
> End With
>
> On Error GoTo XIT
> Set olApp = New Outlook.Application
> Set oNS = olApp.GetNamespace("MAPI")
> Set oContactFolder = oNS.GetDefaultFolder(olFolderContacts)
> Set oContactItems = oContactFolder.Items
>
> With Me
> For i = 1 To oContactItems.Count
> If oContactItems.Item(i).Class = olContact Then
> Set oContact = oContactItems.Item(i)
> If oContact.Categories = "Personal" Then '<<=== CHANGE
> j = j + 1
> ReDim Preserve arr(0 To 2, 1 To j)
> With oContact
> arr(0, j) = .FullName
> arr(1, j) = .HomeAddress
> arr(2, j) = .HomeTelephoneNumber
> End With
> End If
> End If
> Next i
>
> Me.ListBox1.List() = Application.Transpose(arr)
>
> End With
>
> XIT:
> Set oContact = Nothing
> Set oContactItems = Nothing
> Set oContactFolder = Nothing
> Set oNS = Nothing
> Set olApp = Nothing
> End Sub
> '<<=============
>
>
> ---
> Regards,
> Norman

Hi Oggy,

> One final thing, then i promise to leave you alone, When i pull in the
> address i get the carriage return characters, how do i get rid of them?

Try:

'=============>>
Private Sub CommandButton1_Click()
Dim SH As Worksheet
Dim destRng As Range

Set SH = ThisWorkbook.Sheets("Sheet1") '<<=== CHANGE

Set destRng = SH.Range("A" & Rows.Count).End(xlUp)(2)
With Me.ListBox1
destRng.Value = .List(.ListIndex, 0)
destRng(1, 2).Value = _
Replace(.List(.ListIndex, 1), Chr(13), "", 1)
destRng(1, 3).Value = _
Replace(.List(.ListIndex, 2), Chr(13), "", 1)
End With
End Sub
'<<=============



---
Regards,
Norman