Hi folks,
This post was asked on another forum, I'm hoping someone here can help...
(I have, of course, let the user know that it's posted here and given him a link...)
[vba]Originally Posted by DomFino
Public Sub InsertAddressFromOutlook()
Dim strCode As String, strAddress As String
Dim iDoubleCR As Integer
'Set up the formatting codes in strCode
strCode = "<PR_DISPLAY_NAME>" & vbCr & _
"<PR_POSTAL_ADDRESS>" & vbCr & _
"<PR_OFFICE_TELEPHONE_NUMBER>" & vbCr
'Display the 'Select Name' dialog, which lets the user choose
'a name from their Outlook address book
strAddress = Application.GetAddress(AddressProperties:=strCode, _
UseAutoText:=False, DisplaySelectDialog:=1, _
RecentAddressesChoice:=True, UpdateRecentAddresses:=True)
'If user cancelled out of 'Select Name' dialog, quit
If strAddress = "" Then Exit Sub
'Eliminate blank paragraphs by looking for two carriage returns in a row
iDoubleCR = InStr(strAddress, vbCr & vbCr)
Do While iDoubleCR <> 0
strAddress = Left(strAddress, iDoubleCR - 1) & _
Mid(strAddress, iDoubleCR + 1)
iDoubleCR = InStr(strAddress, vbCr & vbCr)
Loop
'Strip off final paragraph mark
strAddress = Left(strAddress, Len(strAddress) - 1)
'Insert the modified address at the current insertion point
Selection.Range.Text = strAddress
End Sub
[/vba]
Cheers,
Ad