Word Macro to transfer data to excel

[montecarlo20]

Hi,

I am trying to create a macro that will pull information from certain areas of a word document to populate an excel spreadshee row. Im having trouble figuring out how to transfer the data from word to excel.

This is what I have so far. Basically this code should hit every inline shape (textbox) copy the contents to excel.

so box 1 should be put in a1, box 2 to b1, box 3 to c1 and so on.

I cant figure out how to get this data to excel.

Sub Document_TextBoxes()


Dim oCtl As InlineShape

Dim oTB
Dim oXLApp As Object, oXLwb As Object, oXLws As Object
Set oXLApp = CreateObject("Excel.Application")
Set oXLwb = oXLApp.Workbooks.Open("K:\Everyone\Test1.xlsm")
'~~> Work with Sheet1. Change as applicable
Set oXLws = oXLwb.Sheets(1)
'Call OpenExcelFile
For Each oCtl In ActiveDocument.InlineShapes

If oCtl.OLEFormat.ProgID = "Forms.TextBox.1" Then

Set oTB = oCtl.OLEFormat.Object

oTB.Select
Selection.Copy



End If

Next


End Sub

[SamT]

Montecarlo,

Welcome to VBAExpress, I hope your visits here are frequent and helpful.

I am not real familiar with Word, but try this:
Option Explicit

Sub Document_TextBoxes()

Dim oCtl As InlineShape
Dim oTB As Object
Dim oXLApp As Object, oXLwb As Object, oXLws As Object
Dim i As Long

Set oXLApp = CreateObject("Excel.Application")
Set oXLwb = oXLApp.Workbooks.Open("K:\Everyone\Test1.xlsm")
'~~> Work with Sheet1. Change as applicable
Set oXLws = oXLwb.Sheets(1)
'Call OpenExcelFile

For Each oCtl In ActiveDocument.InlineShapes
If oCtl.OLEFormat.ProgID = "Forms.TextBox.1" Then
i = i + 1
Set oTB = oCtl.OLEFormat.Object
oTB.Copy
oXLws.Range("A" & i).PasteSpecial
End If
Next

End Sub

[montecarlo20]

Thanks for having me!

im really stuck on this one.

Im getting Runtime error 4605 :The copy method or property is not available because no text is selected.

on this line

oTB.Copy

[SamT]

Sorry. I'm not used to working with Word.

Try this

Sub Document_TextBoxes()

Dim oCtl As InlineShape
Dim oTB As Object
Dim oXLApp As Object, oXLwb As Object, oXLws As Object
Dim i As Long

Set oXLApp = CreateObject("Excel.Application")
Set oXLwb = oXLApp.Workbooks.Open("K:\Everyone\Test1.xlsm")
'~~> Work with Sheet1. Change as applicable
Set oXLws = oXLwb.Sheets(1)
'Call OpenExcelFile

For Each oCtl In ActiveDocument.InlineShapes
If oCtl.OLEFormat.progID = "Forms.TextBox.1" Then
i = i + 1
Set oTB = oCtl.OLEFormat.Object
oXLws.Range("A" & i) = oTB.Value
End If
Next

End Sub