Rick
Here's some general information about automating Outlook
http://www.dicks-clicks.com/excel/olAutomating.htm
For you specific question, here's some example code
Sub GetContact()
Dim olApp As Outlook.Application
Dim olNs As NameSpace
Dim olCi As Object
On Error Resume Next
Set olApp = GetObject(, "Outlook.Application")
If Err.Number = 429 Then
Set olApp = CreateObject("Outlook.Application")
End If
On Error GoTo 0
Set olNs = olApp.GetNamespace("MAPI")
If Not olApp.ActiveInspector Is Nothing Then
Set olCi = olApp.ActiveInspector.CurrentItem
If TypeName(olCi) = "ContactItem" Then
Sheet1.Range("A1").Value = olCi.FullName
Sheet1.Range("a2").Value = olCi.BusinessTelephoneNumber
End If
End If
Set olNs = Nothing
Set olApp = Nothing
End Sub
