I am creating code for looking up titles and departments of certain people that I would add to an excel spreadsheet and have a user from so they can pick the range they want. I have listed the code for what I have below, which does retrieve the position and department from Exchange, but I would like for it not to call on Microsoft Word, but instead use Excel. Is there anything I can do so that I don't have to call to Word for GetAddress?

Sub Gettitle(RibbonControl As IRibbonControl)

'-----------------------------------------------------------------
'Needed because title information not transferring over through Access GAL download
'Makes a call to Microsoft Word to use Getaddress function
'----------------------------------------------------------------
UserForm4.Show

Dim titlerange As Range
Set titlerange = rngTitle


ActiveCell.EntireColumn.Offset(0, 1).Insert
titlerange.Offset(0, 1).EntireColumn.ColumnWidth = 40

Dim objWordApp As Object
Dim strCode As String
Dim strOutdata As String

Dim c As Range
For Each c In titlerange.Cells

Dim strsource As String
strsource = c.Text
'Set up the formatting codes in strCode
strCode = "<PR_TITLE>" & "," & vbNewLine & "<PR_DEPARTMENT_NAME>"
' As GetAddress is not available in MS Excel, a call to MS Word object
' has been made to borrow MS Word's functionality
Application.DisplayAlerts = False
On Error GoTo Err
'Set objWordApp = New Word.Application
Set objWordApp = CreateObject("Word.Application")
strOutdata = objWordApp.GetAddress(strsource, strCode, False, 0, 0, boolManTitle)
objWordApp.Quit
Set objWordApp = Nothing
c.Offset(0, 1) = strOutdata


Application.DisplayAlerts = True

Label1:
Next

titlerange.EntireColumn.Offset(0, 1).AutoFit

Exit Sub

Err:
c.Offset(0, 1) = "Title Not Located."
Resume Label1:


End Sub