Urgent Word/Outlook Integration Macro

[Shauna Koppang]

Sorry in haste pasted in the wrong macro. Here is the
correct one - Busy morning!!

Sub InsertAddressFromOutlook()
'Macro created by Shauna Koppang May 27, 2004
'Modifed by JGM Newsgroups

Dim strCode As String
Dim strAddress As String
Dim strAddressS As String
Dim iDoubleCR As Integer
Dim FullDetails As String
Dim SplitDetails As Variant

'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>"

strCode = strCode & "__/__" & "<PR_GIVEN_NAME>"

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

SplitDetails = Split(FullDetails, "__/__")
strAddress = SplitDetails(0)
strAddressS = SplitDetails(1)

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 Guy for your assistance!

Shauna