Visio VBA help

[trishc]

I am trying to export shape data from my Visio flowchart. I am hoping to get the shape displayed text, shape number, associated hyperlink description, associated hyperlink address, and the associated comment. I would also be nice to know, if possible, what swimlane function the shape sites in. I also don't want OneD shape, and I only want the flowchart shapes. I figured out the OneD, but not flowchart only shapes. The Shape Report on in Visio doesn't allow me to select the fields I want for output. I created the code below, but can only get the shape text. I split them out so I could try each one. After a few hours, I have given up. Any suggestions?


Sub ShapeInfoToFile()
Dim strPath As String
strPath = "C:\Users\collinsp\Documents\SSC\Chief Technical Officer\Enterprise Architecture\E2E Architecture Working Group\Process"

Dim MyFile As String
MyFile = strPath & "\E2EArchWG Visio Report"
Open MyFile For Output As #2

Dim vPage As Visio.Page
Dim vShape As Visio.Shape
Dim vShapeLinkDes As String
Dim vShapeLink As String
Dim Entry As String
Set vPage = Visio.ActivePage
'Loop through shapes creating a string containing them all, writing to file
For Each Shape In vPage.Shapes
Set vShape = Shape
If Not vShape.OneD Then
Set vShapeLinkDes = vShape.Hyperlink.Description.Value
Set vShapeLink = vShape.Hyperlink.Address.Value
Entry = vShape.Text
' Entry = Entry + "," + vShape.Type
Entry = Entry + "," + vShapeLinkDes
Entry = Entry + "," + vShapeLink
' Entry = Entry + "," + vShape.Comments
Write #2, Entry
End If

Next Shape
End Sub

[trishc]

okay, figured out the Hyperlinks (because there could be multiple, I had to do a loop), now the comments, which are the most important


Sub ShapeInfoToFile()
Dim strPath As String
strPath = "C:\Users\collinsp\Documents\SSC\Chief Technical Officer\Enterprise Architecture\E2E Architecture Working Group\Process"

Dim MyFile As String
MyFile = strPath & "\E2EArchWG Visio Report"
Open MyFile For Output As #2

Dim vPage As Visio.Page
Dim vShape As Visio.Shape
Dim vShapeLinkDes As String
Dim vShapeLink As Hyperlink

Dim Entry As String
Set vPage = Visio.ActivePage
'Loop through shapes creating a string containing them all, writing to file
For Each Shape In vPage.Shapes
Set vShape = Shape
If Not vShape.OneD Then
' Set vShapeLinkDes = vShape.Hyperlink.Description.Value
' Set vShapeLink = vShape.Hyperlinks
Entry = vShape.Text
' Entry = Entry + "," + vShape.Type
' Entry = Entry + "," + vShapeLinkDes

'Loop through the shape hyperlinks
For Each vShapeLink In vShape.Hyperlinks
Entry = Entry + "," + vShape.Hyperlinks.Item(0).Description + "," + vShape.Hyperlinks.Item(0).Address
Next vShapeLink
' Entry = Entry + "," + vShape.Comments
Write #2, Entry
End If

Next Shape
End Sub

[Bob Phillips]

Not sure I will be able to help, I am pretty raw with the Visio OM, but if you could post an example workbook and an idea what the output would look like, I will have a shot at it.

[trishc]

Not sure I will be able to help, I am pretty raw with the Visio OM, but if you could post an example workbook and an idea what the output would look like, I will have a shot at it.

I have given up trying to extract the comment associated with the shape. I realize now the comment is considered another shape. Instead, I manually entered the same number I numbered the shape with at the start of the comment, so I can match them later in Excel. For example, if I numbered the shape 5.2.1, then the comment will start with "5.2.1".
So I now generate two files, one with only "process" shape data, and one with the comment data.


The only issue I have is that it only works on the active page, despite adding in the For each page in the active document code. Maybe I am missing something. If I can get that to work, I am good to go. Because I do the loop twice, the first time for the shapes, and the second time for the comments, I need to make sure I start back at the first page for each loop through the document. Any suggestions?


Sub ShapeInfoToFile()
Dim strPath As String
strPath = ActiveDocument.Path
Dim MyFile As String
MyFile = strPath & "E2EArchWG Visio Shape Report"
MyFile2 = strPath & "E2EArchWG Visio Comment Report"
Open MyFile For Output As #2
Open MyFile2 For Output As #3

Dim vDoc As Visio.Document

Dim vShape As Visio.Shape
Dim vComments As Visio.Comments
Dim vShapeLink As Hyperlink
Dim vPage As Visio.Page
Dim Entry As String
Dim sText As String

Set vDoc = Visio.ActiveDocument

' Loop through shapes creating a string containing them all, writing to file
For Each Page In vDoc.Pages
Set vPage = Visio.ActivePage
For Each Shape In vPage.Shapes
Set vShape = Shape
If Not vShape.Master Is Nothing Then
' Select only Process shapes
If vShape.Master.NameU = "Process" Then
' Get Page Name
Entry = vPage.Name

' Get shape displayed text
Entry = Entry + "," + vShape.Text

' Loop through the shape Hyperlinks
For Each vShapeLink In vShape.Hyperlinks
Entry = Entry + "," + vShape.Hyperlinks.Item(0).Description + "," + vShape.Hyperlinks.Item(0).Address
Next vShapeLink

' Append shape comment
' Entry = Entry + "," + vShape.Comments
Write #2, Entry

End If
End If
Next
Next
'Loop through comments creating a string containing them all
For Each Page In vDoc.Pages
Set vPage = Visio.ActivePage
For Each vComment In vPage.Comments
sText = vPage.Name + "," + vComment.Text
Write #3, sText
Next
Next

End Sub