Extracting all text-box text from doc

pickarooney

I'd like to be able to copy all the text out of the textboxes in a document and write them to another file, preferably with the page number of the text box appended.
There doesn't seem to be any textbox property of Document, so I'm not sure what angle to approach this from.

Any ideas?

tempest

Dim Shape s 
Dim TextFrame t

Set s = Document.Shapes(index) ' TextBoxes are shapes

Set t = s.TextFrame ' Shapes have textframes

t.TextRange.Text ' Contains the text

pickarooney

Excellent, thanks tempest.

pickarooney

Got it working, but it's a little more complicated than I thought. Apparently some of the boxes are textboxes and some are callouts and some are some third kind of object.
I'm using the HasText property of TextFrame to check if there's anythign to copy, but it's picking up a couple of extra non-character strings (just boxes) from some of the objects.
Wonder what that is?

pickarooney

The non-character bits were actually embedded picture objects, which I filtered out.
It works almost like I want it now, but I have problems with grouped objects, it basically ignores elements in the group. There's a property of Shape called Ungroup, but when I use it I get a permission denied error although I can ungroup them when I open the file and right-click.

tempest

Dim shape as Shape

' for each item (shape1.GroupItems )

Set shape = shape1.GroupItems(index)

should work. can't for the life of me remember for syntax in VB though. Getting too late on Thursday....

pickarooney

Hmm, I tried this:

For Each s In ActiveDocument.Shapes
     If s.GroupItems.Count > 0 Then
        For Each tShape In s.GroupItems
            tShape.Ungroup
        Next tShape
    End If
    If s.TextFrame.HasText = True Then
        mString = mString & s.TextFrame.TextRange.Text
    End If
Next s

It fails on the second line, as the first object in the document doesn't seem to be a group. Also, I don't know if that second For statement is right, I'm kind of assigning an Item to a Shape.


[edit]OK, got it (by checking shape.typ against msoGroup).

tempest

Sub test()
    Dim s As Shape
    Dim mString As String
    
    For Each s In ActiveDocument.Shapes
       ProcessShape s, mString
    Next s
    MsgBox mString

End Sub


Sub ProcessShape(ByRef s As Shape, ByRef mString As String)
    Dim tShape As Shape
    If s.Type = msoGroup Then
        For Each tShape In s.GroupItems
            ProcessShape tShape, mString
        Next tShape
    End If
    If s.TextFrame.HasText = True Then
        mString = mString & s.TextFrame.TextRange.Text
    End If
End Sub

I see you figured it anyway.

btw there is no need to ungroup the shapes... unless you need to for another reason.

pickarooney

Just trying to figure out from reading it - will your code handle groups of groups (of groups) of objects? Mine doesn't, as yet.

tempest

pickarooney wrote:

Just trying to figure out from reading it - will your code handle groups of groups (of groups) of objects? Mine doesn't, as yet.

Yep!

pickarooney

Testing it now, seesm to work like a dream. Cheers

tempest

pickarooney wrote:

Testing it now, seesm to work like a dream. Cheers

No bother..

I like to revisit my VB/VBA every now and again, just to keep it fresh.

I really like the Microsoft object models and the ease you can access them with VBA. Whatever else people might say about the company, the designers put an awful lot of effort into building really good object models for their applications, and coupled with VB it makes it easy to write powerful applications.

I'd never trust it in a mission critical environment, but for run of the mill tasks it's difficult to beat it.

RicardoSmith

tempest wrote:

....
I'd never trust it in a mission critical environment, but for run of the mill tasks it's difficult to beat it.

You'd be horrified at some of the VBA stuff I've seen so :eek: