REG:Outlook employee information

have a look here:
http://www.excelforum.com/outlook-fo...ml#post3567396

you wanted the info to be displayed where? I am not sure I know all the fields to display all the info. the oones I know are in the thread mentioned above

try to use this code:

Sub GetOutlookInfo()

On Error Resume Next
Dim I As Integer

Dim ToAddr As String
Dim ActivePersonVerified As Boolean
Dim ol As Outlook.Application
Dim DummyEMail As MailItem
Dim ActivePersonRecipient As Recipient
Dim oAE As Outlook.AddressEntry
Dim oExUser As Outlook.ExchangeUser
Dim oPA As Outlook.PropertyAccessor
Dim AliasRange As Range
Dim RowsInRange As Integer
Dim intAreas As Integer
Dim shtCurrentSheet As String

'check whether the selection is contiguous or not. if not, exit sub
intAreas = Selection.Areas.Count

If intAreas > 1 Then
    MsgBox "Please select a contiguous area, you curently selected " & intAreas & " areas. You can have multiple cells in a single area."
    Exit Sub
End If

'create a new sheet and copy the selection there
shtCurrentSheet = ActiveSheet.Name
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = tmpSheet 'random name, see function below

'add column names
Cells(1, 1) = "email or Name"
Cells(1, 2) = "Name"
Cells(1, 3) = "email address"
Cells(1, 4) = "Department"
Cells(1, 5) = "Job Title"
Cells(1, 6) = "Office Location"
Cells(1, 7) = "Company"
Cells(1, 8) = "Telephone"
Cells(1, 9) = "Manager"

Range("A1:I1").Select
Selection.Font.Bold = True
With Selection
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
End With

'copy the names into the new sheet
Sheets(shtCurrentSheet).Activate
Selection.Copy

Sheets(Sheets.Count).Activate
Range("A2").Select
ActiveSheet.Paste

'code taken from:
'http://social.msdn.microsoft.com/Forums/office/en-US/183a9b77-7f5a-4afc-91e6-fbe2914c5f78/extract-data-from-the-global-address-book-with-vba?forum=outlookdev

'Instantiate Outlook

Set ol = CreateObject("Outlook.Application")
'E-mail aliases are in a named range "aliasrange"
'Assign the named range to a range object

'Set AliasRange = Range("aliasrange")
Set AliasRange = Selection
'Create a dummy e-mail to add aliases to

Set DummyEMail = ol.CreateItem(olMailItem)

RowsInRange = AliasRange.Rows.Count
'Loop through the aliases to retrieve the Exchange data

For I = 1 To RowsInRange
        'Assign the current alias to a variable ToAddr
        ToAddr = AliasRange.Cells(I, 1)
        'Use the alias to create a recipient object and add it to the dummy e-mail

        Set ActivePersonRecipient = DummyEMail.Recipients.Add(ToAddr)
        ActivePersonRecipient.Type = olTo
        'Resolve the recipient to ensure it is valid

        ActivePersonVerified = ActivePersonRecipient.Resolve
        'If valid, use the  AddressEntry property of the recipient to return an AddressEntry object

        If ActivePersonVerified Then
            Set oAE = ActivePersonRecipient.AddressEntry
            'Use the GetExchangeUser method of the AddressEntry object to retrieve the ExchangeUser object for the recipient.

            Set oExUser = oAE.GetExchangeUser
            'Write the properties of the  ExchangeUser object to adjacent columns on the worksheet.

            AliasRange.Cells(I, 1).Offset(0, 1).Value = oExUser.Name
            AliasRange.Cells(I, 2).Offset(0, 1).Value = oExUser.PrimarySmtpAddress
            AliasRange.Cells(I, 3).Offset(0, 1).Value = oExUser.Department
            AliasRange.Cells(I, 4).Offset(0, 1).Value = oExUser.JobTitle
            AliasRange.Cells(I, 5).Offset(0, 1).Value = oExUser.City
            AliasRange.Cells(I, 6).Offset(0, 1).Value = oExUser.CompanyName
            AliasRange.Cells(I, 7).Offset(0, 1).Value = oExUser.BusinessTelephoneNumber
            AliasRange.Cells(I, 8).Offset(0, 1).Value = oExUser.Manager
        End If
        'Remove the recipient from the e-mail
        ActivePersonRecipient.Delete

Next I

ExitOutlookEmail:

    Set DummyEMail = Nothing

    Set ol = Nothing

'autofit columns
Columns("A:I").EntireColumn.AutoFit
Range("A1").Select

End Sub

Function tmpSheet() As String

Dim sLetter(8) As String, sName As String
Dim iLetterType As Integer
Dim I As Integer

sName = ""
For I = 0 To 7
    iLetterType = WorksheetFunction.RandBetween(1, 3)
    Select Case iLetterType
    Case 1
        sLetter(I) = Chr(WorksheetFunction.RandBetween(65, 90))
    Case 2
        sLetter(I) = Chr(WorksheetFunction.RandBetween(97, 122))
    Case 3
        sLetter(I) = Chr(WorksheetFunction.RandBetween(48, 57))
    End Select
    sName = sName & sLetter(I)
Next

tmpSheet = sName
End Function

What excel version are you using? if it is 2007 and newer, what you have to do is open VBA editor (Alt-F11) and then click on Tools --> References and look for Microsoft Outlook xx.0 Object Library (where xx could be 11, 14, etc). once you check that library you will be able to run the code.

you need to select the names you want the macro to get the info for: e.g. A2:a% you have 4 names (or email addresses). Select A2:A5 and then run the code.

I do not know the filed name for that "Seat Number". I am sorry.

you just need to add it to the code besides the other fields. If you find it, come back to the forum and post a new message in this thread.