Urgent! Macro to collect Outlook Address and split

[Shauna Koppang]

Hi,

I have a client that wants to use the double click on
macrobutton to access Outlook, pick a name and have it
inserted into not just a single cell, which I was able to
do, but into 3 cells, a To: and Company: and a Fax Number:
cell. Here is the macro and unfortuneately I leave on
holiday tomorrow and just got this request and I have
meetings all afternoon, so need an immediate answer if
possible. If not, please respond and I will have to reply
and work with you on this after July 13th. Thanks SO
MUCH!!!

New Macro That Needs Help:

Sub InsertAddressFromOutlook()
'Macro created by Shauna Koppang May 25, 2004
'
Dim strCode, strAddress As String
Dim StrAddressC As String
Dim StrAddressF As String
Dim FullDetails As String
Dim SplitDetails As Variant
Dim iDoubleCR As Integer

'Set up the formatting codes in strCode
strCode = strCode & "<PR_DISPLAY_NAME>" & vbVerticalTab
strCode = strCode & "<PR_COMPANY_NAME>" & vbVerticalTab
strCode = strCode & "<PR_BUSINESS_FAX_NUMBER> Fax"

'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_OFFICE_TELEPHONE_NUMBER> Tel"
& vbVerticalTab

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

SplitDetails = Split(FullDetails, "__/__/__")
strAddress = SplitDetails(0)
StrAddressC = SplitDetails(1)
StrAccessF = SplitDetails(2)

'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

'Insert the modified address at the current insertion
point
Selection.TypeText strAddress

' Move to Company Call and Insert Company
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell

Selection.TypeText StrAddressC

' Move to Fax Cell and Insert Fax
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell
Selection.MoveRight Unit:=wdCell

Selection.TypeText StrAddressF

'Insert Username
'Selection.NextField.Select
Selection.PreviousField.Select
Selection.Fields.Add Range:=Selection.Range,
Type:=wdFieldEmpty, Text:= _
"USERNAME ", PreserveFormatting:=True
Selection.NextField.Select

End Sub

 

[Shauna Kopang]

Error Code is Run time error 9 Subscript out of range.

It stops at strAddressC = SplitDetails(1)

If the helps!
Shauna

 

[Charles Kenyon]

You may want to look at http://www.gmayor.com/Macrobutton.htm. This gives an
example of using macrobuttons to insert name and address info from Outlook
Contacts.
--
Charles Kenyon

Word New User FAQ & Web Directory:
<URL: http://www.addbalance.com/word/index.htm>

Intermediate User's Guide to Microsoft Word (supplemented version of
Microsoft's Legal Users' Guide)
<URL: http://www.addbalance.com/usersguide/index.htm>

Word Resources Page
<URL: http://www.addbalance.com/word/wordwebresources.htm>

See also the MVP FAQ: <URL: http://www.mvps.org/word/> which is awesome!
--------- --------- --------- --------- --------- ---------
This message is posted to a newsgroup. Please post replies
and questions to the newsgroup so that others can learn
from my ignorance and your wisdom.