Connecting to External Data

[draco193]

Hello All;

I am trying to use VBA to open an External Data set for me.  I have recorded the follwoing Macro to help do this.

Code Select Expand

Application.ActiveDocument.DataRecordsets.Add "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=True;Initial Catalog=0710_ASTO;Data Source=SEACAT02\SQLDBDEV;Use Procedure for Prepare=1;Auto Translate=True;Packet Size=4096;Workstation ID=SEACAT02;Use Encryption for Data=False;Tag with column collation when possible=False", "select * from ""0710_ASTO"".""dbo"".""RequestTable""", 0, "SEACAT02_SQLDBDEV 0710_ASTO RequestTable"

    Dim vsoPrimaryKeys1(1 To 1) As String
    vsoPrimaryKeys1(1) = "tableName"
    Application.ActiveDocument.DataRecordsets.ItemFromID(122).SetPrimaryKey VisPrimaryKeySettings.visKeySingle, vsoPrimaryKeys1

    Application.ActiveWindow.Windows.ItemFromID(visWinIDExternalData).Visible = True

However, this appears to me to be dependent on when I have run the Macro, because it sets the Primary Key with ItemFromID.   

Is there another way to set the primary key that would let it be indpendent of when the macro was run?  Or, a way to find the Item ID at run time?

[aledlund]

Two examples (one primary, one composite)

ReDim arrPrimaryKeys(0)
arrPrimaryKeys(0) = "compKey"
vsoRecordSet.SetPrimaryKey visKeySingle, arrPrimaryKeys

ReDim arrPrimaryKeys(3)
arrPrimaryKeys(0) = "nbrNodeA"
arrPrimaryKeys(1) = "nbrPortA"
arrPrimaryKeys(2) = "nbrNodeB"
arrPrimaryKeys(3) = "nbrPortB"
vsoRecordSet.SetPrimaryKey visKeyComposite, arrPrimaryKeys

al

[aledlund]

Apologies, I forgot to mention that when I load a datarecordset, I store the id in a userfield in the documentsheet for later referencing so I don't have to chase it. I also set the recordset keys at the point when I load the recordset. Datarecordset ids live with the document, and will change each time that you load the recordset.
al

[draco193]

Hi al;

How were you able to store the id? 

[Visio Guy]

Al said he creates a User-defined cell in the document's ShapeSheet.

You can see this ShapeSheet by holding the Shift key, then choosing: Window > Show ShapeSheet. You can add any number of user cells to a ShapeSheet.

You can then read and write to a cell like this:

visDoc.DocumentSheet.Cells("User.rsID").Formula = Chr ( 34 ) & some_value & Chr ( 34 )

strID = visDoc.DocumentSheet.Cells("User.rsID").Formula

[aledlund]

The visio sdk has several good examples on how to create reusable code to work with custom properties, I took the idea and extended it to other sections of the shapesheet that I tend to work with a lot. Here are two examples of common code that you might consider. Of course since docsheet and pagesheet are also 'shapes' the "adduserpropertytoshape" can be used there as well.
al

Code Select Expand



' example on use
'objRect.Name = "textfield_" & CStr(intFieldNr)

'blnResult = AddUserPropertyToShape(objRect, "width", "width", "width", _
                    objRect.Cells("Width").ResultIU, "width")





    Public Function AddUserPropertyToShape _
                (ByVal visShape As Visio.Shape, _
                ByVal strLocalRowName As String, _
                ByVal strRowNameU As String, _
                ByVal strLabelName As String, _
                ByVal strValue As String, _
                Optional ByVal strPrompt As String = "") _
                As Boolean

        Dim vsoCell As Visio.Cell
        Dim intRowIndex As Integer


            If visShape.SectionExists(visSectionUser, False) = False Then
                visShape.AddSection (visSectionUser)
            End If

            ' get an available row number
            intRowIndex = visShape.AddNamedRow(visSectionUser, _
                 strLocalRowName, _
                 Visio.VisRowIndices.visRowUser)
            ' add a prompt
            Set vsoCell = visShape.CellsSRC(visSectionUser, _
                visRowUser + intRowIndex, visUserPrompt)
            SetCellValueToString vsoCell, strPrompt

            If (strLocalRowName <> strRowNameU And _
                Len(strRowNameU) > 0) Then
                vsoCell.rowNameU = strRowNameU
            End If

            ' add a value
            Set vsoCell = visShape.CellsSRC(visSectionUser, _
                visRowUser + intRowIndex, visUserValue)
            SetCellValueToString vsoCell, strValue

            AddUserPropertyToShape = True


    End Function

    Public Function AddHyperLinkToShape _
                (ByVal visShape As Visio.Shape, _
                ByVal strLocalRowName As String, _
                Optional ByVal strRowNameU As String = "", _
                Optional ByVal strDescription As String = "", _
                Optional ByVal strAddress As String = "", _
                Optional ByVal strSubAddress As String = "", _
                Optional ByVal strFrame As String = "", _
                Optional ByVal blnNewWin As Boolean = False, _
                Optional ByVal blnDefault As Boolean = False) _
                As Boolean

        Dim vsoCell As Visio.Cell
        Dim intRowIndex As Integer

        ' I like to test here so that we know that one is there and don't add
        ' another by mistake
        If visShape.SectionExists(visSectionHyperlink, False) = False Then
            visShape.AddSection (visSectionHyperlink)
        End If

       
        On Error GoTo AddHyperLinkToShape_err
       
            intRowIndex = visShape.AddNamedRow(visSectionHyperlink, _
                 strLocalRowName, _
                 Visio.VisRowIndices.visRow1stHyperlink)

            vsoCell = visShape.CellsSRC(visSectionHyperlink, _
                visRow1stHyperlink + intRowIndex, visHLinkDescription)
            SetCellValueToString vsoCell, strDescription

            If (strLocalRowName <> strRowNameU And _
                Len(strRowNameU) > 0) Then
                vsoCell.rowNameU = strRowNameU
            End If

            ' Column 2: Address
            vsoCell = visShape.CellsSRC(visSectionHyperlink, _
                visRow1stHyperlink + intRowIndex, visHLinkAddress)
            SetCellValueToString vsoCell, strAddress

            ' Column 3: SubAddress
            vsoCell = visShape.CellsSRC(visSectionHyperlink, _
                visRow1stHyperlink + intRowIndex, visHLinkSubAddress)
            SetCellValueToString vsoCell, strSubAddress

            ' Column 4: frame
            vsoCell = visShape.CellsSRC(visSectionHyperlink, _
                visRow1stHyperlink + intRowIndex, visHLinkExtraInfo)
            SetCellValueToString vsoCell, strFrame

            ' Column 5: new window
            vsoCell = visShape.CellsSRC(visSectionHyperlink, _
                visRow1stHyperlink + intRowIndex, visHLinkNewWin)
            SetCellValueToString vsoCell, CStr(blnNewWin)

            ' Column 6: default
            vsoCell = visShape.CellsSRC(visSectionHyperlink, _
                visRow1stHyperlink + intRowIndex, visHLinkDefault)
            SetCellValueToString vsoCell, CStr(blnDefault)

            AddHyperLinkToShape = True
            Exit Function
           
AddHyperLinkToShape_err:

        AddHyperLinkToShape = False

    End Function




[Visio Guy]

Nice Al!

Note: you can get the "shape" object for a document or a page as follows:

doc.DocumentSheet
pg.PageSheet

[VisioBut]

Hello there,

anybody has an idea of why when I call this:

Code Select Expand



connectionString =    "Provider=Microsoft.ACE.OLEDB.12.0;\
                        User ID=Admin;\
                        Data Source=C:\Temp\List.xlsx;\
                        Mode=Read;\
                        Extended Properties=""HDR=YES;IMEX=1;MaxScanRows=0;Excel 12.0;"";\
                        Jet OLEDB:Engine Type=35;
                        ..."     # copied from recording a macro in visio
commandString = "select * from 'Sheet1$'"

visio.ActiveDocument.DataRecordsets.Add(connectionString, commandString, 0,  "Sheet1")    # Unable to connect to the data ?!?
 
I get Unable to connect to the data. although the excel data sheet is closed, and it is not used by anyone else.

[aledlund]

as a guess, I'd suggest the Type s/b 34 instead of 35,

Code Select Expand



    ' Build an Excel connection string to the data source.

    strExcelCommandString = "SELECT * FROM `" & strExcelSheet & "$`"
    strExcelConnectionString = _
        "Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;" + _
        "Data Source=" + _
        strExcelPath + strExcelDoc + ";" + _
        "Mode=Read;Extended Properties=""HDR=YES;IMEX=1;MaxScanRows=0;Excel 12.0;"";" + _
        "Jet OLEDB:Engine Type=34;"
   
    ' Create a new visio recordset and return
    ' it to the calling method.
    Set vsoReturnDataRecordset = vsoTargetDocument.DataRecordsets.Add( _
        strExcelConnectionString, _
        strExcelCommandString, _
        0, _
        strRecordSetName)




[VisioBut]

as a guess, I'd suggest the Type s/b 34 instead of 35,

Thanks. But unfortunately this didnt help. I dont know if it has any influence but Im using python (win32 etc.).

[aledlund]

Since the example code is from a working vba implementation, IMHO python just might be an issue.
I didn't know that Visio had a python interpreter.

al

[VisioBut]

I didn't know that Visio had a python interpreter

It doesnt. Python uses win32com (Python COM support) to work with microsoft automation objects.

P.S. Any idea if I can call a macro to a newly created visio drawing/document ?!?

[aledlund]

Since I'm never quite sure of whether a user might have gotten into the code of a document, for those things that I really want to control I put them into a stencil. This has the benefit of not having to go look for all of those documents that have embedded code that you might want to update (just select the new stencil). I think there is a thread already going on the site about calling code from a stencil.
al

[Nikolay]

Hello there,

Probably you made a mistake copying VBA code to python - you have to replace "" (double quote) with \" (escaped quote).
The VB synatax does not match the Python syntax 

Please see the example below (all generated stuff that is not actually needed is removed):

Code Select Expand


connectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\\Temp\\List.xlsx;Extended Properties=\"Excel 12.0;HDR=YES\";"
commandString = "select * from `Sheet1$`"


[VisioBut]

Probably you made a mistake copying VBA code to python - you have to replace "" (double quote) with \" (escaped quote).
The VB synatax does not match the Python syntax 

Thank you, I thought about this but it wasnt the only reason. Your code worked. It was something with the too many Extended Properties (IMEX=1;MaxScanRows=0 ?!? ...).

With the single parenthesis around the Sheet1$ it worked

Code Select Expand

commandString = "select * from `Sheet1$`" but with normal single ones

Code Select Expand

commandString2 = "select * from 'Sheet1$'"
it didnt ?!?