Save Each Table - To A Text File

[dj44]

folks,

good day,


:)

I am trying to save each table in my document as a text file.

It says longer than 255 characters in my previous testing as the error as to why it wouldnt save my file





Sub SaveTableAsText()



Dim strFolder As String
Dim wdDoc As Document
Dim oTbl As Table
Dim i As Long



strFolder = "C:\Users\DJ\Desktop\Table\"


Set oTbl = ActiveDocument.Tables(i)
For i = 1 To oTbl.Rows.Count
Set wdDoc = Documents.Add



wdDoc.Range.FormattedText = oTbl.Rows(2).Range.FormattedText ' << The main text to save

'wdDoc.SaveAs2 strFolder & Left(oTbl.Cell(i, 1).Range, Len(oTbl.Cell(i, 1).Range) - 2) & ".docx", wdFormatDocumentDefault, , , False


wdDoc.SaveAs2 strFolder & Left(oTbl.Cell(i, 1).Range, Len(oTbl.Cell(i, 1).Range) - 2) & ".txt", wdFormatUnicodeText, , , False ' << File Name



wdDoc.Close
Next i


End Sub



at one point some thing worked, but i sure did do something else.

The Title of each File is in Row 1 Column 1



Thank you for any help

[Kilroy]

DJ this following code (acquired here) will move all tables in a document a new document. The new document is named the same as the original with "Tables" added to it. Not sure how to put each table in its own new document or how to name based on Row 1 column 1 but this is a good start.


Sub CutAndPasteTables()
Dim oDoc As Document
Dim oSource As Document
Dim oTable As Table
Dim oRng As Range
Dim strName As String 'sat the top with the other variables
Set oSource = ActiveDocument
If oSource.Tables.Count > 0 Then
Set oDoc = Documents.Add
Else
MsgBox "There are no tables in the current document"
GoTo lbl_Exit
End If
For Each oTable In oSource.Tables
oTable.Range.Cut 'Copy?
Set oRng = oDoc.Range
oRng.Collapse wdCollapseEnd
oRng.PasteAndFormat wdFormatOriginalFormatting
oDoc.Range.InsertParagraphAfter
Next oTable
strName = oSource.FullName
strName = Left(strName, InStrRev(strName, Chr(46)) - 1) & " Tables.docx"
oDoc.SaveAs2 FileName:=strName 'Save the new document"
oDoc.Close
lbl_Exit:
Exit Sub
End Sub

[dj44]

Hello K,
thank you for this code.

Let me do some experimentation - I know i can copy all the tables to a new document.

When i save them as a file each - it helps me to go directly to my Table as i have to only open the file.

These tables are a bit long and words keeps bouncing so making it hard for me to read my table :doh:

it has text in it but word squahses my tables

Greg once made a very nice one to save each row as a new document, but i changed it and now its gone pear shaped

i'll be back

[Kilroy]

Let me know when you get it figured out. This would be very useful to me. Thanks

[macropod]

VBA cannot save file names & paths that together exceed 255 characters. Furthermore, if you save a Word table to a text file, it will no longer be a table - just tabulated text.

[dj44]

Hello Paul

:)

The Table Column 1 Row 1 has a name - only a few words example

1.3 List of Parts for this

So no 255 character limits

I just wanted to move it for my own reference,

I have lots of tables 1 column 2 rows
its a basic 1 column 2 row table

So i thought i would export my table but then i still have n ot been able to solve this bug :think:

[macropod]

Try:

Sub ExportTables()
Application.ScreenUpdating = False
Dim DocSrc As Document, DocTgt As Document
Dim Tbl As Table, strName As String
Set DocSrc = ActiveDocument
If DocSrc.Tables.Count > 0 Then
For Each Tbl In DocSrc.Tables
'Create a new 'table' document
Set DocTgt = Documents.Add(Visible:=False)
With DocTgt
'replicate the table
.Range.FormattedText = Tbl.Range.FormattedText
'construct the filename
strName = DocSrc.Path & "\" & Split(Tbl.Range.Cells(1).Range.Text, vbCr)(0) & " Table.docx"
'Save the new document"
.SaveAs2 FileName:=strName, FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False
.Close False
End With
Next Tbl
Else
MsgBox "There are no tables in the current document"
End If
Application.ScreenUpdating = True
End Sub
To save as a plain text file, change:
" Table.docx"
to:
" Table.txt"
and change:
wdFormatXMLDocument
to:
wdFormatText

[dj44]

Hello Paul

Thank you for making this happen

I've been stuck on this one line for the past two days

wdDoc.SaveAs2 strFolder & Left(oTbl.Cell(i, 1).Range, Len(oTbl.Cell(i, 1).Range) - 2) & ".txt",

And then word was giving me a lot of problems

Now don't get me wrong yes I can add a bookmark to a table and go there but everytime I load up word it takes like nearly two minutes
And then sometimes it doesn't even load up


So this causes me considerable distress when I have to look up a table somewhere in the document

I also need to open it from my cell phone and there's no space on it because word is such a big application

so I wanted to open the text files and so I needed to export the tables to the text

Now Greg once helped me with a table solution which is the aforementioned code right at the top but then I wanted to export the tables

And I couldn't do that because there was something wrong with VBA not recognising the module code or something like that
So I had to change it to

Word.Table

One last thing I need to do is to trim the cell marker, but I'll do that slowly I believe I need to put in the left function

I've been very upset with word lately because it keeps adding in all these weird characters here there and everywhere making my life even more difficult than before but oh well such is life

Thank you for helping me Paul you are a super Champion of the VBA Arts

And good evening to you :friends:

[macropod]

In the code I posted:
Split(Tbl.Range.Cells(1).Range.Text, vbCr)(0)
does much the same as:
Left(Tbl.Range.Cells(1).Range.Text, Len(Tbl.Range.Cells(1).Range.Text) - 2)
the big difference, though, is that the Split approach only gets the first paragraph's content, ignoring any other paragraphs in the same cell.

[dj44]

oh thats good to know Paul,
I dont know what word was complaining about when it crashed :dau:

it showed me a cell marker in the error message its like a square with slanting line at each corner.

So I got rid of the space at the begining of the cell and it worked

I will clean up my Titles that will make it better

a job for the weekend clean up my documents now

- :grinhalo:

thanks again

And thank you to the great forum and all the great people who come here - oustanding kindness always shown and for helping me

hope to see you all in the fall -

Happy Summer Folks

:beerchug: