EVilli
03-10-2021, 07:12 PM
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
propName.Copy
xlBook.Sheets("Input").[i_prop_name].PasteSpecial Excel.xlPasteValues
Dim propAddress As Object
Set propAddress = ActiveDocument.Bookmarks("i_prop_Address").Range
propAddress.Copy
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
Orig.Copy
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.
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
propName.Copy
xlBook.Sheets("Input").[i_prop_name].PasteSpecial Excel.xlPasteValues
Dim propAddress As Object
Set propAddress = ActiveDocument.Bookmarks("i_prop_Address").Range
propAddress.Copy
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
Orig.Copy
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.