Question

我有一个visio文件，以前从不同的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

结束子

将先前导入的外部数据从visio导出回excel

0 个答案: