Chuck: On the off chance that you haven't found this already, search for a
post from David Lee - MVP Outlook expert. He lists a script which will allow
you to print outlook contact pictures. I haven't tried it yet so can't vouch
for its workabilithy.

Another post suggested using screen snapshot as a last resort.
(ALT+PRTSCRN) If you're considering that solution know that MS OneNote has a
screen clipper that is very useful. -Erin

Text w/ the script info that David Lee posted:

D.Lee 8/16/2007 6:26 AM PST



I agree with Brian on their being no way to do this from Outlook itself,
but
we can accomplish this with a bit of scripting. The script below will print
the currrently selected contact to include a picture if present. This is
only a proof of concept. A production script would print all the relevant
fields rather than the small list of fields I am using here. It would also
check to see if there are multiple attachments and, if so, scan through them
to find the picture. This does work though. I've tested using Outlook 2003
and it worked beautifully. The advantage of doing it this way is that you
have full control over the resulting output. You can choose your fonts, add
graphics, lay it out any way you want to.

Sub PrintContact()
'Picture is named: ContactPicture.jpg
Const PICTURE_PATH = "C:\Temp\ContactPicture.jpg"
Const FILE_PATH = "C:\Temp\PrintContact.html"
Const OLECMDID_PRINT = 6
Const OLECMDEXECOPT_DONTPROMPTUSER = 2
Const READYSTATE_COMPLETE = 4
Dim olkContact As Outlook.ContactItem, _
olkProp As Outlook.ItemProperty, _
objFSO As Object, _
objFile As Object, _
objIE As Object
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.CreateTextFile(FILE_PATH, True)
Set olkContact = Application.ActiveExplorer.Selection(1)
With olkContact
objFile.WriteLine Session.CurrentUser
objFile.WriteLine "hr"
objFile.WriteLine "table"
objFile.WriteLine " trtd width=""15%""bFull Name:/b/tdtd
width=""85%""" & .FullName & "/td/tr"
objFile.WriteLine " trtd width=""15%""bLast Name:/b/tdtd
width=""85%""" & .LastName & "/td/tr"
objFile.WriteLine " trtd width=""15%""bFirst
Name:/b/tdtd width=""85%""" & .FirstName & "/td/tr"
objFile.WriteLine " trtd width=""15%""bCompany:/b/tdtd
width=""85%""" & .CompanyName & "/td/tr"
objFile.WriteLine " trtd width=""15%""bBusiness
Address:/b/tdtd width=""85%""" & .BusinessAddress & "br" &
..BusinessAddressCity & ", " & .BusinessAddressState & " " &
..BusinessAddressPostalCode & "/td/tr"
objFile.WriteLine " trtd width=""15%""bBusiness:/b/tdtd
width=""85%""" & .BusinessTelephoneNumber & "/td/tr"
objFile.WriteLine " trtd width=""15%""bMobile:/b/tdtd
width=""85%""" & .MobileTelephoneNumber & "/td/tr"
objFile.WriteLine " trtd width=""15%""bBusiness
Fax:/b/tdtd width=""85%""" & .BusinessFaxNumber & "/td/tr"
objFile.WriteLine " trtd width=""15%""bE-mail:/b/tdtd
width=""85%""" & .Email1Address & "/td/tr"
objFile.WriteLine " trtd width=""15%""bE-mail Display
As:/b/tdtd width=""85%""" & .Email1DisplayName & "/td/tr"
objFile.WriteLine " trtd width=""15%""bWeb Page:/b/tdtd
width=""85%""" & .WebPage & "/td/tr"
If .HasPicture Then
If .Attachments.Count = 1 Then
..Attachments.Item(1).SaveAsFile PICTURE_PATH
objFile.WriteLine " trtd
width=""15%""bPictu/b/tdtd width=""85%""img src=""" &
PICTURE_PATH & """/td/tr"
End If
End If
objFile.WriteLine "/table"
End With
objFile.Close
Set objIE = CreateObject("InternetExplorer.Application")
objIE.Navigate2 "file:\\" & FILE_PATH
Do Until objIE.readyState = READYSTATE_COMPLETE
DoEvents
Loop
objIE.ExecWB OLECMDID_PRINT, OLECMDEXECOPT_DONTPROMPTUSER
Set objFile = Nothing
Set objFSO = Nothing
Set olkProp = Nothing
Set olkContact = Nothing
Set objIE = Nothing
End Sub

--
David Lee - MVP Outlook