Urgent !- Outlook & Word Integration

[Shauna Koppang]

I have the following code and I can get it to do what I
want it to do, except it brings up the Outlook Address
dialog box twice. I need it to bring it up once. The
first places the address at the current location, the
second goes to the Salutation Bookmark and places the
GIVEN_NAME there. Please help - Urgent - Project due this
morning!!

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

 

[Jean-Guy Marcil]

Bonjour,

Dans son message, < Shauna Koppang > écrivait :
In this message, < Shauna Koppang > wrote:

|| I have the following code and I can get it to do what I
|| want it to do, except it brings up the Outlook Address
|| dialog box twice. I need it to bring it up once. The
|| first places the address at the current location, the
|| second goes to the Salutation Bookmark and places the
|| GIVEN_NAME there. Please help - Urgent - Project due this
|| morning!!
||

Try this instead:

'_______________________________________
Sub InsertAddressFromOutlook()
'Macro created by Shauna Koppang May 25, 2004
'Modified by JGM!

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

--
Salut!
_______________________________________
Jean-Guy Marcil - Word MVP
(e-mail address removed)
Word MVP site: http://www.word.mvps.org

 

[Guest]

Hi Guy,

THANK YOU THANK YOU THANK YOU!!! You are a life saver

Worked perfectly!!

Shauna

 

[Jean-Guy Marcil]

Bonjour,

Dans son message, < (e-mail address removed) > écrivait :

| Hi Guy,
|
| THANK YOU THANK YOU THANK YOU!!! You are a life saver
|
| Worked perfectly!!
|

Ouch, my ears! <g>
You're welcome!

--
Salut!
_______________________________________
Jean-Guy Marcil - Word MVP
(e-mail address removed)
Word MVP site: http://www.word.mvps.org