Attribute VB_Name = "InsertAddress" Option Explicit Sub AddCommandToInsertMenu() Dim CustAddress, InsCommand, ctrlAny As CommandBarControl Set InsCommand = CommandBars("Insert") For Each ctrlAny In InsCommand.Controls 'reset/remove just in case If ctrlAny.Caption = "Custom Addr&ess" Then ctrlAny.Delete Next ctrlAny Set CustAddress = InsCommand.Controls.Add(Type:=msoControlButton) CustAddress.Caption = "Custom Addr&ess" CustAddress.TooltipText = "Custom" CustAddress.Style = msoButtonCaption CustAddress.OnAction = "InsertCustomAddress" End Sub Sub InsertCustomAddress() On Error GoTo ErrorHandler: Dim AddressLayout, AddressDetails, strErrorMsg As String If Documents.Count = 0 Then Exit Sub 'Need open document in which to paste ' Define the layout of the address, using any of the fields listed at ' the end of this macro. AddressLayout = "" & vbCr & _ "" & vbCr & _ "" & vbCr & _ "" & vbCr & _ "" & vbCr & _ "" ' Get the address details AddressDetails = Application.GetAddress(Name:="", AddressProperties:=AddressLayout, _ DisplaySelectDialog:=1, CheckNamesDialog:=True) ' Insert the address details, according to the defined layout ' Blank fields are not removed, so an empty paragraph appears Selection.InsertAfter AddressDetails ' Move the pointer to the end of the inserted text Selection.EndKey Unit:=wdLine, Extend:=wdMove ErrorHandler: If Str(Err.Number) <> 0 Then ' error number 0 is correct termination. strErrorMsg = "Error # " & Str(Err.Number) & " was generated by " _ & Err.Source & Chr(13) & Err.Description MsgBox strErrorMsg End If End Sub ' ============================================================= ' These are the properties and their description (taken from the Microsoft ' Word Visual Basic help). ' Property Name Description ' PR_DISPLAY_NAME Name displayed in the Address Book dialog box ' PR_GIVEN_NAME First name ' PR_SURNAME Last name ' PR_STREET_ADDRESS Street address ' PR_LOCALITY City or locality ' PR_STATE_OR_PROVINCE State or province ' PR_POSTAL_CODE Postal code ' PR_COUNTRY Country ' PR_TITLE Job title ' PR_COMPANY_NAME Company name ' PR_DEPARTMENT_NAME Department name within the company ' PR_OFFICE_LOCATION Office location ' PR_PRIMARY_TELEPHONE_NUMBER Primary telephone number ' PR_PRIMARY_FAX_NUMBER Primary fax number ' PR_OFFICE_TELEPHONE_NUMBER Office telephone number ' PR_OFFICE2_TELEPHONE_NUMBER Second office telephone number ' PR_HOME_TELEPHONE_NUMBER Home telephone number ' PR_CELLULAR_TELEPHONE_NUMBER Cellular telephone number ' PR_BEEPER_TELEPHONE_NUMBER Beeper telephone number ' PR_COMMENT Text included on the Notes tab for the address entry ' PR_EMAIL_ADDRESS Electronic mail address ' PR_ADDRTYPE ELectronic mail address type ' PR_OTHER_TELEPHONE_NUMBER Alternate telephone number (other than home or office) ' PR_BUSINESS_FAX_NUMBER Business fax number ' PR_HOME_FAX_NUMBER Home fax number ' PR_RADIO_TELEPHONE_NUMBER Radio telephone number ' PR_INITIALS Initials ' PR_LOCATION Location, in the format buildingnumber/roomnumber (for example, 7/3007 represents room 3007 in building 7) ' PR_CAR_TELEPHONE_NUMBER Car telephone number