Vba 如何将visio外部数据导出到excel

我有一个旧的VISIO文件，上面有外部数据。数据的源文件不再存在。 我尝试将数据从visio复制并粘贴到excel，但没有成功

然后，我试图通过VBA访问数据，但我不理解得到的结果： （行的数量是当前的，但数据有时是好的，有时不是）

您知道如何将此数据从visio获取到excel吗

谢谢 阿萨夫

更新：添加了源代码输出：我重新检查了，不知道数据来自哪里。。。

---

这篇文章很旧，但我遇到了同样的问题，并找到了解决办法。在发布的代码中，您正在引用每个

DataRecordSet

并抓取第一行，而不是找到正确的一行并抓取所有行

我们还必须避免使用

i

从0计数到

外部数据；行ID可以跳过数字，因此必须使用正确的
数据记录集中的真实ID

下面的代码并不十分漂亮，但它可以工作。请注意，
链接的
布尔值并不是数据集的真正组成部分；但是，它相当于外部数据窗口中的“链”图标

这是为Visio2013编写的，但我相信它也适用于其他版本。运行此操作后，可以使用
%
作为分隔符将文件导入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

你是说数据是正确的，有时是错误的？有时数据有什么不正确的地方？添加了屏幕截图-我相信我的代码引用了错误的位置-甚至只有行有数据，它提醒了原始数据，但仅此而已。
    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