Hello Friends, I have code for extracting word tables to excel sheets.. but it stops working after extracting some tables. Code is this:



The error alert says: Methos Pastespecial of object_Worksheet failed.

Please help...


Sub ImportWordTables()
Dim wdApp As Object
Dim wdDoc As Object
Dim wdFileName As Variant
Dim tableNo As Long
Dim tableStart As Long
Dim tableTot As Long
Dim resultRow As Long
Dim fStart As Boolean
Dim wSheet As Worksheet

wdFileName = Application.GetOpenFilename("Word files (*.doc*),*.doc*", , _
"Browse for file containing table to be imported")

If wdFileName = False Then Exit Sub '(user cancelled import file browser)

On Error Resume Next
Set wdApp = GetObject(Class:="Word.Application")
If wdApp Is Nothing Then
Set wdApp = CreateObject(Class:="Word.Application")
fStart = True
End If
On Error GoTo ErrHandler

Set wdDoc = wdApp.Documents.Open(Filename:=wdFileName) 'open Word file

' Repetition to force Word to calculate the correct count
tableTot = wdDoc.Tables.Count
tableTot = wdDoc.Tables.Count
tableTot = wdDoc.Tables.Count
If tableTot = 0 Then
MsgBox "This document contains no tables", vbExclamation, "Import Word Table"
ElseIf tableTot > 1 Then
tableStart = Val(InputBox("This Word document contains " & tableTot & " tables." & vbCrLf & _
"Enter the table to start from", "Import Word Table", "1"))
If tableStart < 1 Then
Beep
Exit Sub
End If
Else
tableStart = 1
End If

resultRow = 4

For tableNo = tableStart To tableTot
Set wSheet = Worksheets.Add(After:=Worksheets(Worksheets.Count) )
wSheet.Name = "Table " & tableNo
wdDoc.Tables(tableNo).Range.Copy
DoEvents
wSheet.Cells(resultRow, 1).Select
DoEvents
wSheet.PasteSpecial Format:="HTML"
Next tableNo

ExitHandler:
On Error Resume Next
wdDoc.Close SaveChanges:=False
If fStart Then
wdApp.Quit SaveChanges:=False
End If
Exit Sub

ErrHandler:
MsgBox Err.Description, vbExclamation, "Import Word Table"
Resume ExitHandler
End Sub

Can you perhaps attach a sample document that has one table where it works and one where it does not?
How to attach a screenshot or file in this forum.

On this file don't works.

Attached Files

1.doc (458.0 KB, 3 views)

I think this is because file has line or page breaks?

Also one that does work?

I dont know it worked while ago for this file but now it seems that don't works

Attached Files

Report.docx (283.8 KB, 1 views)

Since this seems to be a procedure started from Excel, I should move the question to the Excel Programming forum, I believe. I am in the process of doing so.

No answer?

I tested on your first doc and the macro worked fine. I did a few little fiddles to your code while I was reading through it but I don't think those alterations changed the operation in any way.

I suspect your machine may have needed a restart to clear up some memory space.

__________________
Andrew Lockton
Chrysalis Design, Melbourne Australia