这篇文章很旧,但我遇到了同样的问题并有解决方案。在您发布的代码中,您引用每个DataRecordSet
并抓取第一行,而不是找到正确的代码并抓取所有行。
我们还必须避免使用i
从 0 计数到ExternalData.Count
; 行 ID 可以跳过数字,因此您必须使用正确的真实 ID DataRecordset
。
以下代码并不完全漂亮,但它可以工作。请注意,linked
布尔值并不是数据集的真正一部分;但是,它相当于外部数据窗口中的“链”图标。
这是为 Visio 2013 编写的,但我相信它也适用于其他版本。%
运行后,您可以使用分隔符将文件导入 Excel 。
Sub WriteDataSourceToFile()
' REQUIRES: Microsoft Scripting Runtime (C:\Windows\SysWOW64\scrrun.dll)
' Below we'll intentionally cause array length errors to test each Row
On Error Resume Next
' Use this to put the drawing name in the first column of each row
Dim DrawingLabel As String
DrawingLabel = "DRAWING_NAME_HERE"
' Used for getting the External Data from a specific window
Dim PagObj As Visio.Page
Dim vsoDataRecordset As Visio.DataRecordset
' Used for grabbing all shapes with a link to the current Row
Dim shapeIDs() As Long
Dim testLong As Long
' Currently only using the above as a test (linked or not linked)
Dim linked As Boolean
' Stores all Row IDs from the DataRecordset and loops through each
Dim dataRowIDs() As Long
Dim dataRowID As Variant
' Stores the actual Row information and appends to rowSTR for the delimited line
Dim rowData() As Variant
Dim rowDataInt As Integer
Dim rowSTR As String
' Used for text file output
Dim fso As FileSystemObject
Set fso = New FileSystemObject
' Create a TextStream and point it at a unique filename (based on the active document)
Dim stream As TextStream
Set stream = fso.CreateTextFile("C:\Users\Public\Documents\GEN_" & ActiveDocument.Name & ".txt", True)
' Look through each window and find External Data (matches 2044)
For Each win In Visio.ActiveWindow.Windows
If win.ID = 2044 Then
Set vsoDataRecordset = win.SelectedDataRecordset
Exit For
End If
Next win
' Get each Row ID from the DataRecordSet
dataRowIDs = vsoDataRecordset.GetDataRowIDs("")
' Use each Row ID as a reference
For Each dataRowID In dataRowIDs
linked = False
' Look through all pages and attempt to get Shape IDs linked to the active Row
For Each PagObj In ActiveDocument.Pages
PagObj.GetShapesLinkedToDataRow vsoDataRecordset.ID, dataRowID, shapeIDs
' Attempting to reference a 0-length array will throw an error here
testLong = UBound(shapeIDs)
If Err.Number Then
Err.Clear
Else
' If it didn't throw an error referencing the array, there's at least one linked shape
linked = True
Exit For
End If
Next PagObj
' Build the output
rowSTR = linked
' Get the array of Row Data
rowData = vsoDataRecordset.GetRowData(dataRowID)
' Go through each column and append the value to the output string
For rowDataInt = 0 To UBound(rowData)
' Using % as a delimeter to prevent text with commas causing a separated column
rowSTR = rowSTR & "%" & rowData(rowDataInt)
Next rowDataInt
'Output the string to the file, putting the label at the beggining of the row
stream.WriteLine DrawingLabel & "%" & rowSTR
Next dataRowID
stream.Close
End Sub