Hi,
if you have external data in your document, the following code exports each DataRecordset to Excel.
Regards,
Thomas
Sub exportDataRecordSets()
Dim drs As Visio.DataRecordset
Dim dataRowIDs() As Long
Dim xlsApp As Excel.Application
Dim xlsWB As Excel.Workbook
Dim xlsWS As Excel.Worksheet
Dim arr() As String
Dim txt As String
Dim i As Integer
If ActiveDocument.DataRecordsets.Count = 0 Then Exit Sub
Set xlsApp = New Excel.Application
xlsApp.Visible = False
Set xlsWB = xlsApp.Workbooks.Add
For Each drs In ActiveDocument.DataRecordsets
Set xlsWS = xlsWB.Worksheets.Add(After:=xlsWB.Worksheets(xlsWB.Worksheets.Count))
xlsWS.name = drs.name
txt = ""
For i = 1 To drs.DataColumns.Count
txt = txt & drs.DataColumns.item(i).name & ";"
Next i
txt = Left(txt, Len(txt) - 1)
arr = Split(txt, ";")
xlsWS.Range(xlsWS.Cells(1, 1), xlsWS.Cells(1, UBound(arr) + 1)).Value = arr
dataRowIDs = drs.GetDataRowIDs("")
For i = LBound(dataRowIDs) To UBound(dataRowIDs)
xlsWS.Range(xlsWS.Cells(i + 2, 1), xlsWS.Cells(i + 2, UBound(arr) + 1)).Value = drs.GetRowData(dataRowIDs(i))
Next i
xlsWS.ListObjects.Add(xlSrcRange, xlsWS.Range(xlsWS.Cells(1, 1), xlsWS.Cells(i + 1, UBound(arr) + 1)), , xlYes).name = drs.name
xlsWS.Cells.EntireColumn.AutoFit
Next drs
xlsWB.Worksheets(1).Delete
xlsWB.Worksheets(1).Activate
xlsApp.Visible = True
End Sub