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

--
Dick Kusleika
MVP - Excel
www.dicks-clicks.com
Post all replies to the newsgroup.

"Rick Slaugh" wrote in message
...
I need to populate a few cells in a sheet based on the current open
Outlook
Contact. Any snippets would be appreciated.

Thanks,
Rick Slaugh