Read open excel file from visio

[noclass1980]

Hi, I have this simple code running from Visio which falls over at line 10 with subscript out of range. I want Visio to read the excel file and add shapes with text to a drawing but I can't even access the excel workbook. I believe I have the necessary References ticked. Any suggestions? Thanks in advance.

Code Select Expand

Option Explicit


Public Sub Export_Shape_Data()
    Dim shp As Visio.Shape
    Dim AppExcel As Object 'Excel.Application
    Dim wkbook As Excel.Workbook
    Dim wkbooksheet As Object 'Excel.Worksheet
    Dim i As Integer
    Dim shpname As String
    Dim a As String
   
    Set AppExcel = CreateObject("Excel.Application")
10  Set wkbook = AppExcel.Workbooks("SampleWB.xlsx")
    Set wkbooksheet = wkbook.worksheets("Sheet2")
    wkbook.Sheets("Sheet2").Select

End Sub

[wapperdude]

The only thing I see, line 10 doesn't know where to find the file.  You have to established its location.  See http://visguy.com/vgforum/index.php?topic=7450.0 as example.

Wapperdude

[Croc]

Use:
...GetObject(, "Excel.Application")
...Workbooks("SampleWB.xlsx")

or
...CreateObject("Excel.Application")
...Workbooks.Add("[full path]\SampleWB.xlsx")

[noclass1980]

Thanks, what I would like to do is read an already open Excel file so that I can run the Visio macro, make some changes to the Excel file and re-run the Visio macro. The question then is how to "tell" the macro that the file is already open.

[Croc]

Try to get existing objects and check errors. If error, then create objects.
Approximately like this:

Code Select Expand

On Error Resume Next
  Set AppExcel = GetObject(, "Excel.Application")
  If Not AppExcel Is Nothing Then
    Set wkbook = AppExcel.Workbooks("SampleWB.xlsx")
    If Not wkbook Is Nothing Then
      'All OK. File is already open
    Else
      'Application exists, but you need to open file
      Set wkbook = AppExcel.Workbooks.Add("[full path]\SampleWB.xlsx")
    End If
  Else
    'need create application
    Set AppExcel = CreateObject("Excel.Application")
    'and open file
    Set wkbook = AppExcel.Workbooks.Add("[full path]\SampleWB.xlsx")
  End If
On Error GoTo 0

[noclass1980]

No joy, I'm afraid. Removing the On Error line, gives a subscript out of range error at the "Set wkbook = AppExcel.Workbooks("SampleWB.xlsx")" line. The excel file is already open but Visio isn't able to see that it is. Any suggestions?

[Croc]

Perhaps you have created several instances of Excel.Application.
Each instance contains its own set of Workbooks.
It's like your situation.
Restart the operating system and try my code again.

[Croc]

See this topic for working with multiple instances of Excel
https://stackoverflow.com/questions/30363748/having-multiple-excel-instances-launched-how-can-i-get-the-application-object-f
The following code (Sub Test) shows all Excel instances and workbooks in them.

Code Select Expand

#If VBA7 Then
  Private Declare PtrSafe Function AccessibleObjectFromWindow Lib "oleacc" ( _
    ByVal hwnd As LongPtr, ByVal dwId As Long, riid As Any, ppvObject As Object) As Long

  Private Declare PtrSafe Function FindWindowExA Lib "user32" ( _
    ByVal hwndParent As LongPtr, ByVal hwndChildAfter As LongPtr, _
    ByVal lpszClass As String, ByVal lpszWindow As String) As LongPtr
#Else
  Private Declare Function AccessibleObjectFromWindow Lib "oleacc" ( _
    ByVal hwnd As Long, ByVal dwId As Long, riid As Any, ppvObject As Object) As Long

  Private Declare Function FindWindowExA Lib "user32" ( _
    ByVal hwndParent As Long, ByVal hwndChildAfter As Long, _
    ByVal lpszClass As String, ByVal lpszWindow As String) As Long
#End If

Sub Test()
  Set c = GetExcelInstances()
  'For Each xl In GetExcelInstances()
  Dim cc As Collection
  Set cc = New Collection
  On Error Resume Next
  For j = 1 To c.Count
    cc.Add c(j), CStr(c(j).hwnd)
  Next
  On Error GoTo 0
  For j = 1 To cc.Count
    Debug.Print "hwnd: " & cc(j).hwnd
    For i = 1 To cc(j).Workbooks.Count
        Debug.Print "-----> " & cc(j).Workbooks(i).Name
    Next
  Next
End Sub

Public Function GetExcelInstances() As Collection
  Dim guid&(0 To 3), acc As Object, hwnd, hwnd2, hwnd3
  guid(0) = &H20400
  guid(1) = &H0
  guid(2) = &HC0
  guid(3) = &H46000000

  Set GetExcelInstances = New Collection
  Do
    hwnd = FindWindowExA(0, hwnd, "XLMAIN", vbNullString)
    If hwnd = 0 Then Exit Do
    hwnd2 = FindWindowExA(hwnd, 0, "XLDESK", vbNullString)
    hwnd3 = FindWindowExA(hwnd2, 0, "EXCEL7", vbNullString)
    If AccessibleObjectFromWindow(hwnd3, &HFFFFFFF0, guid(0), acc) = 0 Then
      GetExcelInstances.Add acc.Application
    End If
  Loop
End Function
Example output

Code Select Expand

hwnd: 131894
-----> Copy of task19.xls
-----> bpmn.xlsx
hwnd: 131804
-----> test2.xlsx

[wapperdude]

Without the error checking, and it assumes that the Excel file exists, it doesn't have to be open, but can be, this code will just open it again.  I ran it 3 successive times, ended with three windows of the same file.  Make sure you have all of the references set for use.

Code Select Expand


Sub OpenXcl()
' The following references are used:
'   Visual Basic for Applications
'   Microsoft Visio Type Library
'   OLE Automation
'   Microsoft Office Object Library
'   Microsoft Excel Object Library
'   You'll have to choose the appropriate versions based upon your installation
'
    Dim XlApp As Object
    Dim XlWrkbook As Excel.Workbook
    Dim XlSheet As Excel.Worksheet
    Set XlApp = CreateObject("Excel.Application")
   
    XlApp.Workbooks.Open "H:\YourDir\Sch Netlist Test.xlsx"  'NOTE:  Replace the path and the filename to actual path and name.
   
    Set XlWrkbook = XlApp.Workbooks(1)
    Set XlSheet = XlWrkbook.Worksheets("Sheet1")
    XlApp.Visible = True

End Sub


[Nikolay]

You can connect your Visio drawing to the Excel data using data binding functionality (look at the "Data" tab!)
You don't have to do it programmatically, i.e. you don't need any code. It is much easier.

For exporting data to Excel, you have shape reports button.

If you want Visio to build a diagram from excel data, you could use new data visualizer.
https://support.office.com/en-us/article/create-a-data-visualizer-diagram-17211b46-d144-4ca2-9ea7-b0f48f0ae0a6