I have a word form that has about 50 content controls on it, mostly rich text controls and some checkboxes. As well as an excel workbook that is formatted with 20+ worksheets.

I'm trying to get some of the typed information from Word to export into excel in different specific spots on one worksheet in the book.

The Word document is used as a questionnaire for me to fill out my area of the workbook so I use a fresh one of each every time there's a new client.

I've spent the past 3 days looking for information and ended up with a somewhat working code. I have an issue with some information not populating in the excel document that I can't figure out. I also removed a lot of the-
variables in the middle because it would be redundant.

I know this code is ugly but it was the best I could do :/

Sub Click_to_Export_Click()

On Error Resume Next
'this error message is so the other cells will populate

Dim WD As Document
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook

Set xlApp = Excel.Application
Set WD = ActiveDocument

xlApp.Visible = True

choice = Application.FileDialog(msoFileDialogOpen).Show

If choice <> 0 Then

    strPath = Application.FileDialog(msoFileDialogOpen).SelectedItems(1)

    Set xlBook = xlApp.Workbooks.Open(strPath)

End If

'First half is to select the excel file to use

Dim propName As Object
    Set propName = ActiveDocument.Bookmarks("i_prop_name").Range
    xlBook.Sheets("Input").[i_prop_name].PasteSpecial Excel.xlPasteValues
Dim propAddress As Object
    Set propAddress = ActiveDocument.Bookmarks("i_prop_Address").Range
    xlBook.Sheets("Input").[i_prop_address].PasteSpecial Excel.xlPasteValues

-------------------------Removed 6 other bookmarks here---------------------------------

Dim Orig As Object
    Set Orig = ActiveDocument.Bookmarks("i_team_originator").Range
xlBook.Sheets("Input").[i_team_originator].PasteSpecial Excel.xlPasteValues

'this error message is to inform that manual entry is needed

If Err.Number <> 0 Then
MsgBox "It looks like one or more fields was not properly transfered. Please enter Manually" & vbCrLf & "Error - " & Err.Description
End If

End Sub
I know there's probably an easier way to loop and search for the info but I just started learning VBA on Monday and haven't gotten used to loops.

Any help would be greatly appreciated, Thanks!

p.s. I have all of this for a button if that makes any difference.