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.
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?
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
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
Hi al;
How were you able to store the id?
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
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
' 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
Nice Al!
Note: you can get the "shape" object for a document or a page as follows:
doc.DocumentSheet
pg.PageSheet
Hello there,
anybody has an idea of why when I call this:
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.
as a guess, I'd suggest the Type s/b 34 instead of 35,
' 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)
Quote from: aledlund on July 29, 2009, 08:00:48 PM
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.).
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
Quote from: aledlund on July 30, 2009, 11:38:12 AMI 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 ?!?
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
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 :D
Please see the example below (all generated stuff that is not actually needed is removed):
connectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\\Temp\\List.xlsx;Extended Properties=\"Excel 12.0;HDR=YES\";"
commandString = "select * from `Sheet1$`"
Quote from: Nikolay Belyh on July 30, 2009, 01:57:50 PM
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 :D
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
commandString = "select * from `Sheet1$`"
but with normal single ones
commandString2 = "select * from 'Sheet1$'"
it didnt ?!?
Quote from: VisioBut on July 31, 2009, 03:38:35 PM
Thank you, I thought about this but it wasn't the only reason. Your code worked. It was something with the too many Extended Properties (IMEX=1;MaxScanRows=0 ?!? ...).
You can google on these extra parameters to see if you really need them. ;)
This can depend on the data you have in your excel sheet.
Quote from: VisioBut on July 31, 2009, 03:38:35 PM
With the single parenthesis around the Sheet1$ it worked commandString = "select * from `Sheet1$`"
but with normal single ones
commandString2 = "select * from 'Sheet1$'"
it didnt ?!?
As far as I know, the correct ones are the `back-quotes` (or `back-ticks`, or how do you call those :)). These are needed, because the "table name" (identifier Sheet1$) contains a special symbol ($). Visual Basic macro recorder seems to generate these back-quotes correctly, so probably the copy operation just erroneously changed those into "regular" quotes. I believe you could also use square brackets - [Sheet1$] instead of `Sheet1$`, - but 'Sheet1$' is illegal, because it is not an sql identifier, but a text literal.
Kind regards, Nikolay.
Can anybody tell what is wrong here?
A dropped shape is linked, and through the linking additional shape data (new properties) is defined.
m1 = visio.Documents.OpenEx(stencil,flags).Masters("ShapeName")
shape = page.Drop( m1, 0, 0 )
shape.LinkToData(Recordset.ID,rowNr[0])
if shape.CellExists("Prop.NewKind",0)
After the linking the new properties are not found.(at least checking with the if statement above doesnt find them) When I right-click on the shape, the properties are there though ... ?!?
A couple of questions on the shape you are linking.
Is the property you are testing for predefined in the shape?
Does python accept an inferred response from an if statement (if shape.cellexists("prop.newkind",false) = true)?
al
Quote from: aledlund on August 04, 2009, 11:34:09 AM
Is the property you are testing for predefined in the shape?
No, its
additional, i.e. it is
not predefined.
Quote from: aledlund on August 04, 2009, 11:34:09 AMDoes python accept an inferred response from an if statement (if shape.cellexists("prop.newkind",false) = true)?
I dont think I understand your question. But if a cell property exists it will evaluate the statement as true.
I've seen case where
if shape.cellexists("prop.newkind",false) then...
did not work, where
if shape.cellexists("prop.newkind",false) = true then...
does work. The first case infers that the response to the test is enough while the second case does not.
al
I have worked out a way of confirming the code is correct by using the macro record method. This may or may not be a correct way to confirm these processes and would like some advise:
Sub linkExcel()
'Enable diagram services
Dim DiagramServices As Integer
DiagramServices = ActiveDocument.DiagramServicesEnabled
ActiveDocument.DiagramServicesEnabled = visServiceVersion140 + visServiceVersion150
Application.ActiveDocument.DataRecordsets.Add "Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;Data Source=C:\Users\Octal-Core\Desktop\NetpbcNodeOamIpAddresses.xlsx;Mode=Read;Extended Properties=""HDR=YES;IMEX=1;MaxScanRows=0;Excel 12.0;"";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Engine Type=37;Jet OLEDB:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:New Database Password="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Locale on Compact=False;Jet OLEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False;Jet OLEDB:Support Complex Data=False;Jet OLEDB:Bypass UserInfo Validation=False;Jet OLEDB:Limited DB Caching=False;Jet OLEDB:Bypass ChoiceField Validation=False", "select * from `NetpbcNodeOamIpAddresses$`", 0, "NetpbcNodeOamIpAddresses"
Dim vsoPrimaryKeys1(1 To 2) As String
vsoPrimaryKeys1(1) = "#dev-name-primary"
vsoPrimaryKeys1(2) = "#ip-address"
Application.ActiveDocument.DataRecordsets.ItemFromID(2).SetPrimaryKey VisPrimaryKeySettings.visKeyComposite, vsoPrimaryKeys1
Application.ActiveWindow.Windows.ItemFromID(visWinIDExternalData).Visible = True
End Sub
I would like some help loading these 2 columns in a index type search function, maybe an array, not sure. My data excel sheet is over 10,000 records long. The data looks like the following:
vnnycag01 10.72.9.72
vnnycag02 10.72.9.73
vnnycag03 10.72.9.74
vnnycag04 10.72.9.75
vnnycag05 10.72.9.76
vnnycag06 10.72.9.77
vnnycag07 10.72.9.78
vnnycag08 10.72.9.79
vnnycag09 10.72.9.84
vnnycag10 10.72.9.85
vnnycag11 10.72.9.86
vnnycag12 10.72.9.87
I am trying to match the first column (Hostname) and copy the second column data in a specific text box with these names:
strSDG01
strSDG02
strASR01
strASR02
strIPS01
strIPS02
strANU01
strANU02
strANU03
once I have matched the host names and moved the IP's over to the box, the rest of my program works great.
Can anyone help?