oldmanwilly
Board Regular
- Joined
- Feb 24, 2016
- Messages
- 221
Hi
need to copy the answers of 50 questions in word into excel. The word document also contains tables. here is a link to the first part of the questionnaire questionnaire-part-1 and here is a link to the how the tables look in the file: questionnaire-part-2. Ideally i want column A to have the question(which i can just manually enter, and column B to have the answer. Where there are tables i want them to be placed in a separate sheet with each table table header(i maunually just enter these) and row corresponds to the answer in the word document.
I had an idea of creating bookmarks for each question and then pasting in what was after the bookmark. But maybe thats not possible due to bookmarking would need to be done on every new document? i found the below code but while there is no error the code doesnt paste anything.
could you try and help me?
Thanks
need to copy the answers of 50 questions in word into excel. The word document also contains tables. here is a link to the first part of the questionnaire questionnaire-part-1 and here is a link to the how the tables look in the file: questionnaire-part-2. Ideally i want column A to have the question(which i can just manually enter, and column B to have the answer. Where there are tables i want them to be placed in a separate sheet with each table table header(i maunually just enter these) and row corresponds to the answer in the word document.
I had an idea of creating bookmarks for each question and then pasting in what was after the bookmark. But maybe thats not possible due to bookmarking would need to be done on every new document? i found the below code but while there is no error the code doesnt paste anything.
VBA Code:
sub TryThis()
Dim oWord As Word.Application
Dim oDoc As Word.document
Dim vBkMarks As Variant
Dim vRecord
Dim rRecord As Range
Dim nFields As Long
Dim i As Long
vBkMarks = Array("Bookmark1", "Bookmark2", "Bookmark3") 'etc...
ReDim vRecord(LBound(vBkMarks) To UBound(vBkMarks))
nFields = UBound(vBkMarks) - LBound(vBkMarks) + 1
On Error Resume Next
Set oWord = GetObject(, "Word.Application")
On Error GoTo 0
If oWord Is Nothing Then _
Set oWord = CreateObject("Word.Application")
Set oDoc = oWord.ActiveDocument
For i = LBound(vBkMarks) To UBound(vBkMarks)
vRecord(i) = oDoc.Bookmarks(vBkMarks(i)).Range.Text
Next i
With Sheets("DataTable")
.Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Resize( _
1, nFields).Value = vRecord
End With
End Sub
could you try and help me?
Thanks