Visio Text extraction

A (slightly unfinished) script for extracting text from visio diagrams. Similarly works for Powerpoint also.

Sub ExtText()
Dim pPage As Page
Dim sShape As Shape
Dim fso As Scripting.FileSystemObject
Dim ts1 As TextStream
Dim DDocument As Document

Set fso = CreateObject(”Scripting.FileSystemObject”)
For Each DDocument In Application.Documents
Set ts1 = fso.CreateTextFile(Application.ActiveDocument.Path & “\” & DDocument.Name & “.txt”, False)
For Each pPage In DDocument.Pages
For Each sShape In pPage.Shapes
Debug.Print sShape.Text
ts1.Write (sShape.Text)
On Error Resume Next
Next
Next
Next
MsgBox “Done”End Sub

This will work for all active Visio diagrams.