Convert Word Macro To Excel

[cjamps]

I am looking to bring certain outlook comtacts from my address book into excel. This macro works in word. Is it possible to revise it for excel.

Public Sub InsertDataFromOutlook()
Dim strForename As String
Dim strSurname As String
Dim strAddress As String
Dim strHomePhone As String
Dim strCellPhone As String
Dim oTable As Table
Dim oRng As Range

    'Set up the formatting codes in strCode
    strForename = "<PR_GIVEN_NAME>"
    strSurname = "<PR_SURNAME>"
    strHomePhone = "<PR_HOME_TELEPHONE_NUMBER>"
    strCellPhone = "<PR_CELLULAR_TELEPHONE_NUMBER>"
    strAddress = "<PR_EMAIL_ADDRESS>"


    'Let the user choose the name in Outlook
    strSurname = Application.GetAddress("", strSurname, _
                                        False, 1, , , True, True)
    If strSurname = "" Then
        MsgBox "User cancelled or no name listed", , "Cancel"
        GoTo lbl_Exit
    End If
    strForename = Application.GetAddress("", strForename, _
                                         False, 2, , , True, True)
    strHomePhone = Application.GetAddress("", strHomePhone, _
                                          False, 2, , , True, True)
    strCellPhone = Application.GetAddress("", strCellPhone, _
                                          False, 2, , , True, True)
    strAddress = Application.GetAddress("", strAddress, _
                                        False, 2, , , True, True)

    If ActiveDocument.Tables.Count = 0 Then
        Set oTable = ActiveDocument.Tables.Add(ActiveDocument.Range, 1, 6)
        Set oRng = oTable.Rows(1).Cells(1).Range
        oRng.End = oRng.End - 1
        oRng.Text = "Last Name"
        Set oRng = oTable.Rows(1).Cells(2).Range
        oRng.End = oRng.End - 1
        oRng.Text = "First Name"
        Set oRng = oTable.Rows(1).Cells(3).Range
        oRng.End = oRng.End - 1
        oRng.Text = "Phone"
        Set oRng = oTable.Rows(1).Cells(4).Range
        oRng.End = oRng.End - 1
        oRng.Text = "Cell"
        Set oRng = oTable.Rows(1).Cells(5).Range
        oRng.End = oRng.End - 1
        oRng.Text = "Email Address"
        Set oRng = oTable.Rows(1).Cells(6).Range
        oRng.End = oRng.End - 1
        oRng.Text = "Amount Paid"
    Else
        Set oTable = ActiveDocument.Tables(1)
    End If
    oTable.Rows.Add
    Set oRng = oTable.Rows.Last.Cells(1).Range
    oRng.End = oRng.End - 1
    oRng.Text = strSurname
    Set oRng = oTable.Rows.Last.Cells(2).Range
    oRng.End = oRng.End - 1
    oRng.Text = strForename
    Set oRng = oTable.Rows.Last.Cells(3).Range
    oRng.End = oRng.End - 1
    oRng.Text = strHomePhone
    Set oRng = oTable.Rows.Last.Cells(4).Range
    oRng.End = oRng.End - 1
    oRng.Text = strCellPhone
    Set oRng = oTable.Rows.Last.Cells(5).Range
    oRng.End = oRng.End - 1
    oRng.Text = strAddress
lbl_Exit:
    Set oRng = Nothing
    Set oTable = Nothing
    Exit Sub
End Sub

Private Sub Document_New()

End Sub