UtterAccess.com
X   Site Message
(Message will auto close in 2 seconds)

Welcome to UtterAccess! Please ( Login   or   Register )

Custom Search
 
   Reply to this topicStart new topic
> Pulling Word Table Content Into Excel, Office 2013    
 
   
Access_Johnc
post Nov 8 2017, 05:33 AM
Post#1



Posts: 479
Joined: 5-July 01
From: Glasgow, Scotland


Morning,

I've got a bit of code running through a bunch of Word documents in a folder and pulling any entries in a table it finds into Excel.

Works great but I can't tell which document each table is coming from sine there are lots of Word files in my folders.

Can anybody help me to add the Word filename onto each row in Excel.

Thanks,

John



CODE
Sub ImportWordTable()
'On Error Resume Next
'Application.ScreenUpdating = False
'Application.DisplayAlerts = False


Dim oWordApp As Word.Application
Dim wdDoc As Word.Document
Dim MyFile As String
Dim wdFileName As Variant
Dim TableNo As Integer 'table number in Word
Dim iRow As Long 'row index in Excel
Dim iCol As Integer 'column index in Excel
Dim i As Long
Dim r As Long, c As Long
Dim vDirectory As String
Dim lastrow As Long

Set objWord = CreateObject("Word.Application")
lastrow = ThisWorkbook.Worksheets("Data").Range("A" & ThisWorkbook.Worksheets("Data").Rows.Count).End(xlUp).Row

r = 1
c = 1

vDirectory = "D:\Test2" & Worksheets(1).Range("B9").Value & "\"

vFile = Dir(vDirectory & "*.doc*")

Do While vFile <> ""

Set wdDoc = Documents.Open(Filename:=vDirectory & vFile, ReadOnly:=True)

'Start my loop

With wdDoc
TableNo = wdDoc.tables.Count
    If .tables.Count > 0 Then
        For i = 1 To TableNo
            With .tables(i)
                'copy cell contents from Word table cells to Excel cells
                For iRow = lastrow To .Rows.Count
                    For iCol = 1 To .Columns.Count
                    On Error Resume Next
                        Worksheets("Data").Cells(r, c) = Trim(WorksheetFunction.Clean(Replace(Replace(.cell(iRow, iCol).Range.Text, Chr(13), " "), Chr(10), "")))
                        c = c + 1
                    Next iCol
                    c = 1
                    r = r + 1
                Next iRow
            End With
            c = 1
        Next i
    End If
End With

        wdDoc.Close SaveChanges:=False
        vFile = Dir
    Loop

Application.ScreenUpdating = True
Application.DisplayAlerts = True

End Sub
Go to the top of the page
 
GroverParkGeorge
post Nov 8 2017, 07:41 AM
Post#2


UA Admin
Posts: 31,201
Joined: 20-June 02
From: Newcastle, WA


Sorry, I had to delete my first answer, but I found a better reference for an alternative to Dir() for examining files and getting various properties.

--------------------
Go to the top of the page
 
Access_Johnc
post Nov 8 2017, 07:58 AM
Post#3



Posts: 479
Joined: 5-July 01
From: Glasgow, Scotland


Thanks George,

I'm not sure how to use the example, I thought the filename was already defined as part of the code.

Dim MyFile As String
Dim wdFileName As Variant

But couldn't see how to concatenate that into where it writes the table entries to the spreadsheet
Go to the top of the page
 
GroverParkGeorge
post Nov 8 2017, 08:08 AM
Post#4


UA Admin
Posts: 31,201
Joined: 20-June 02
From: Newcastle, WA


Ah, I see. Although I still prefer the FSO for such tasks, you can do it this way.

It depends, in part, on where and how you want to store the doc name. If you want it to be in Column A for each row, you can add it into the code:

I'd try it this way first, and adjust as necessary to get the desired results

.....
CODE
For iRow = lastrow To .Rows.Count

    Worksheets("Data").Cells(r,1) = vDirectory & vFile
     c=2
    For iCol = 1 To .Columns.Count
          On Error Resume Next
           Worksheets("Data").Cells(r, c) = Trim(WorksheetFunction.Clean(Replace(Replace(.cell(iRow, iCol).Range.Text, Chr(13), " "), Chr(10), "")))
           c = c + 1
      Next iCol
      c = 1
      r = r + 1
Next iRow

--------------------
Go to the top of the page
 
Access_Johnc
post Nov 8 2017, 08:31 AM
Post#5



Posts: 479
Joined: 5-July 01
From: Glasgow, Scotland


George,

Absolutely perfect.

I was a bit slow on the uptake but got there in the end.

Many thanks,

John
Go to the top of the page
 
GroverParkGeorge
post Nov 8 2017, 09:03 AM
Post#6


UA Admin
Posts: 31,201
Joined: 20-June 02
From: Newcastle, WA


I'm glad to hear you resolved the problem.

Continued success with your project.

--------------------
Go to the top of the page
 
Access_Johnc
post Nov 16 2017, 07:46 AM
Post#7



Posts: 479
Joined: 5-July 01
From: Glasgow, Scotland


George,

Sorry if this seems like it should be a new topic/question but any idea how I could grab the contents of the individual Word document page header and incorporate it into a cell of this routine?

Thanks,

John
Go to the top of the page
 
GroverParkGeorge
post Nov 16 2017, 08:27 AM
Post#8


UA Admin
Posts: 31,201
Joined: 20-June 02
From: Newcastle, WA


It can be done, but Word automation isn't high on my list of go-to skills wary.gif

One thing you can often do is create a macro in Word (I usually work with Excel, not Word, but it should be similar) to get a "starter kit". Then you can bring that bit of code over to your other app and work out the details.

Of course, a more knowledgeable Word user could have the syntax handy already.

--------------------
Go to the top of the page
 


Custom Search
RSSSearch   Top   Lo-Fi    13th December 2017 - 03:55 PM