Urgent - Word and Outlook Integration Macro

[Shauna Koppang]

I am trying to have it read the address into the current
location and then move to the bookmark Salutation, then
insert the GIVEN_NAME at that location. I can get it to
do it but it brings the Outlook Address dialog box up
twice, where as I need it to come up once. This is
urgent as the project is due today and this came up at
end of day yesterday. Thanks SOOOO MUCH!

Sub InsertAddressFromOutlook()
'Macro created by Shauna Koppang May 25, 2004
'
Dim strCode, strAddress As String
Dim strCodeS, strAddressS As String
Dim iDoubleCR As Integer

'Set up the formatting codes in strAddress

strCode = strCode & "<PR_COMPANY_NAME>" & vbVerticalTab
strCode = strCode & "<PR_STREET_ADDRESS>" &
vbVerticalTab
strCode = strCode & "<PR_LOCALITY>,
<PR_STATE_OR_PROVINCE>" & vbVerticalTab
strCode = strCode & "<PR_COUNTRY> <PR_POSTAL_CODE>" &
vbVerticalTab & vbVerticalTab
strCode = strCode & "Attention: " & vbTab
& "<PR_DISPLAY_NAME>" & vbVerticalTab
strCode = strCode & vbTab & vbTab & "<PR_TITLE>"

strCodeS = strCodeS & "<PR_GIVEN_NAME>"

'Let the user choose the name in Outlook - Fix this
strAddress = Application.GetAddress("", strCode, False,
1, , , True, True)
strAddressS = Application.GetAddress("", strCodeS,
False, 1, , , True, True)

Selection.TypeText strAddress

'Makes the attention block bold
Selection.HomeKey Unit:=wdLine, Extend:=wdExtend
Selection.MoveUp Unit:=wdLine, Count:=1,
Extend:=wdExtend
Selection.Font.Bold = wdToggle
Selection.MoveDown Unit:=wdLine, Count:=1
Selection.MoveUp Unit:=wdLine, Count:=1
Selection.EndKey Unit:=wdLine
Selection.NextField.Select

'Moves and selects salutation placeholder and puts in
GIVEN_NAME
'ActiveDocument.Bookmarks("Salutation").Select
Selection.TypeText strAddressS

'Eliminate blank lines by looking for two carriage
returns in a row
iDoubleCR = InStr(strAddress, vbCr & vbCr)
While iDoubleCR <> 0
strAddress = Left(strAddress, iDoubleCR - 1) & Mid
(strAddress, iDoubleCR + 1)
iDoubleCR = InStr(strAddress, vbCr & vbCr)
Wend

Selection.NextField.Select

End Sub

 

[Shauna Koppang]

Thanks! Found the solution.