Hi All,

I have applied the below macro in a word document.

The macro should extract all the name of the person into a Excel file, however, it shows Run-time error '5941', not sure how to resolve this, May I request you to check and provide help on this please.

The output in the Excel file would be

AAA
BBB
DDD
XXX
ZZZ
KKK
RRR


I have attached the document herewith

Sub CopyNamesToExcel()
Dim oTable As Table
Dim oRng As Range
Dim xlApp As Object
Dim xlBook As Object
Dim xlSheet As Object
Dim xlCell As Object
Dim i As Integer, j As Integer
Dim sName As String
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
If Err Then
Set xlApp = CreateObject("Excel.Application")
End If
On Error GoTo 0
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Sheets(1)
xlApp.Visible = True
'Set xlCell = xlSheet.Range("A1")
'xlCell.value = "Name"
'j = 2
j = 1
For Each oTable In ActiveDocument.Tables
Set oRng = oTable.Cell(1, 2).Range
oRng.End = oRng.End - 1
If InStr(1, oRng.Text, "NAMES OF PERSON") > 0 Then
sName = Replace(oRng.Text, "NAMES OF PERSON", "")
sName = Replace(sName, Chr(13), "")
Set xlCell = xlSheet.Range("A" & j)
xlCell.value = Trim(sName)
j = j + 1


End If
Next oTable
End Sub

Attached Files

Source.docx (15.5 KB, 4 views)

The macro I wrote for you related to the earlier sample document. This document has a different and random table formats which are more difficult to handle. Furthermore the string that relates to the name is different in all but one of the tables in the new sample and the name placement is different in some of the tables.

While it may be possible to produce a macro that would cater for this document, the amount of work involved is not insignificant, and given that you keep moving the goal posts, the chances are you will come up with another document that has a different table format.

__________________
Graham Mayor - MS MVP (Word) (2002-2019)
Visit my web site for more programming tips and ready made processes www.gmayor.com

Hi gmayor, I completely understood and its absolutely fine to skip this

Thanks for all your help you provided

Just fyi, the next document we will going to receive after 6-8 months.