accessing Outlook Address book from Excel VBA
 

Hi All,

I'd like to retrieve some data (name, department, e-mail address) of members
of a group from Outlook Address book from Excel VBA. Please, help me how to
do it!

Thanks,
Stefi

accessing Outlook Address book from Excel VBA
 

Hi Steffi,

Add a reference to the Outlook library:

Alt-F11 to open the VBE,

Menu | Tools | References |
Find and check: Microsoft Outlook xx Object Library
(xx is the version number.)

Insert a Userfom with a ListBox and
a CommandButton; in the Userform
module post the following code:

'=============
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

'-----------------
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


"Stefi" wrote in message
...
Hi All,

I'd like to retrieve some data (name, department, e-mail address) of
members
of a group from Outlook Address book from Excel VBA. Please, help me how
to
do it!

Thanks,
Stefi

accessing Outlook Address book from Excel VBA
 

Thanks, Norman, I'm going to give it a try and let you know the result later!
Stefi


€žNorman Jones€� ezt Ã*rta:

Hi Steffi,

Add a reference to the Outlook library:

Alt-F11 to open the VBE,

Menu | Tools | References |
Find and check: Microsoft Outlook xx Object Library
(xx is the version number.)

Insert a Userfom with a ListBox and
a CommandButton; in the Userform
module post the following code:

'=============
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

'-----------------
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


"Stefi" wrote in message
...
Hi All,

I'd like to retrieve some data (name, department, e-mail address) of
members
of a group from Outlook Address book from Excel VBA. Please, help me how
to
do it!

Thanks,
Stefi

accessing Outlook Address book from Excel VBA
 

Hi Norman,

Your code works, but I have still a problem:

Set oContactFolder = oNS.GetDefaultFolder(olFolderContacts)
returns my personal Address book, but I need a group and its members from
the company's global Address book. I can't find out how to identify and
access it.

Please help!

Regards,
Stefi


€žStefi€� ezt Ã*rta:

Thanks, Norman, I'm going to give it a try and let you know the result later!
Stefi


€žNorman Jones€� ezt Ã*rta:

Hi Steffi,

Add a reference to the Outlook library:

Alt-F11 to open the VBE,

Menu | Tools | References |
Find and check: Microsoft Outlook xx Object Library
(xx is the version number.)

Insert a Userfom with a ListBox and
a CommandButton; in the Userform
module post the following code:

'=============
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

'-----------------
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


"Stefi" wrote in message
...
Hi All,

I'd like to retrieve some data (name, department, e-mail address) of
members
of a group from Outlook Address book from Excel VBA. Please, help me how
to
do it!

Thanks,
Stefi

accessing Outlook Address book from Excel VBA
 

Hi Stefi,

Using Outlook methods, I do not believe
that you interrogate the Global Address
book (GAL) to obtain the department
details.

To return the name and email details, in
the Userform module, try something like:

'=============
Option Explicit
Dim arr() As String

Private Sub UserForm_Initialize()
Dim olApp As Outlook.Application
Dim oNS As Outlook.Namespace

Dim oAL As AddressList
Dim oAE As AddressEntry
Dim i As Long
Dim j As Long

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 oAL = oNS.AddressLists(1)

With Me
For i = 1 To oAL.AddressEntries.Count
Set oAE = oAL.AddressEntries.Item(i)
j = j + 1
ReDim Preserve arr(1 To 3, 1 To j)
With oAE
arr(1, j) = .Name
arr(2, j) = .Address
arr(3, j) = .GetContact
End With
Next i
Me.ListBox1.List() = Application.Transpose(arr)
End With

XIT:
Set oAE = Nothing
Set oAL = Nothing
Set oNS = Nothing
Set olApp = Nothing
End Sub

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

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

Set destRng = SH.Range("A" & Rows.Count).End(xlUp)(2)
destRng.Resize(UBound(arr, 2), 2).Value = _
Application.Transpose(arr) 'arr2
End Sub
'<<=============

In order to interrogate the GAL further, see
the techniques used by Pavel Nagaev at:

Import Active Directory user data into Outlook address books
http://www.outlookexchange.com/artic...agaev_c1p4.asp

---
Regards.
Norman


"Stefi" wrote in message
...
Hi Norman,

Your code works, but I have still a problem:

Set oContactFolder = oNS.GetDefaultFolder(olFolderContacts)
returns my personal Address book, but I need a group and its members from
the company's global Address book. I can't find out how to identify and
access it.

Please help!

Regards,
Stefi


€žStefi€� ezt Ã*rta:

Thanks, Norman, I'm going to give it a try and let you know the result
later!
Stefi


€žNorman Jones€� ezt Ã*rta:

Hi Steffi,

Add a reference to the Outlook library:

Alt-F11 to open the VBE,

Menu | Tools | References |
Find and check: Microsoft Outlook xx Object Library
(xx is the version number.)

Insert a Userfom with a ListBox and
a CommandButton; in the Userform
module post the following code:

'=============
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

'-----------------
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


"Stefi" wrote in message
...
Hi All,

I'd like to retrieve some data (name, department, e-mail address) of
members
of a group from Outlook Address book from Excel VBA. Please, help me
how
to
do it!

Thanks,
Stefi

accessing Outlook Address book from Excel VBA
 

Thanks Norman for your guidance, it'll be a nice job to follow it!
Regards,
Stefi


€žNorman Jones€� ezt Ã*rta:

Hi Stefi,

Using Outlook methods, I do not believe
that you interrogate the Global Address
book (GAL) to obtain the department
details.

To return the name and email details, in
the Userform module, try something like:

'=============
Option Explicit
Dim arr() As String

Private Sub UserForm_Initialize()
Dim olApp As Outlook.Application
Dim oNS As Outlook.Namespace

Dim oAL As AddressList
Dim oAE As AddressEntry
Dim i As Long
Dim j As Long

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 oAL = oNS.AddressLists(1)

With Me
For i = 1 To oAL.AddressEntries.Count
Set oAE = oAL.AddressEntries.Item(i)
j = j + 1
ReDim Preserve arr(1 To 3, 1 To j)
With oAE
arr(1, j) = .Name
arr(2, j) = .Address
arr(3, j) = .GetContact
End With
Next i
Me.ListBox1.List() = Application.Transpose(arr)
End With

XIT:
Set oAE = Nothing
Set oAL = Nothing
Set oNS = Nothing
Set olApp = Nothing
End Sub

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

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

Set destRng = SH.Range("A" & Rows.Count).End(xlUp)(2)
destRng.Resize(UBound(arr, 2), 2).Value = _
Application.Transpose(arr) 'arr2
End Sub
'<<=============

In order to interrogate the GAL further, see
the techniques used by Pavel Nagaev at:

Import Active Directory user data into Outlook address books
http://www.outlookexchange.com/artic...agaev_c1p4.asp

---
Regards.
Norman


"Stefi" wrote in message
...
Hi Norman,

Your code works, but I have still a problem:

Set oContactFolder = oNS.GetDefaultFolder(olFolderContacts)
returns my personal Address book, but I need a group and its members from
the company's global Address book. I can't find out how to identify and
access it.

Please help!

Regards,
Stefi


€žStefi€� ezt Ã*rta:

Thanks, Norman, I'm going to give it a try and let you know the result
later!
Stefi


€žNorman Jones€� ezt Ã*rta:

Hi Steffi,

Add a reference to the Outlook library:

Alt-F11 to open the VBE,

Menu | Tools | References |
Find and check: Microsoft Outlook xx Object Library
(xx is the version number.)

Insert a Userfom with a ListBox and
a CommandButton; in the Userform
module post the following code:

'=============
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

'-----------------
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


"Stefi" wrote in message
...
Hi All,

I'd like to retrieve some data (name, department, e-mail address) of
members
of a group from Outlook Address book from Excel VBA. Please, help me
how
to
do it!

Thanks,
Stefi