database refresh from code

[Bruce Hensley]

I have a collection of charts and template and stencil that created them in
Visio 2002 Standard. There is a master with database links, with an on drop
event that prompts for the database record. After linking to the data, an
OLE link to a figure file is added, and the two shapes are grouped. There
are many instances of these grouped shapes. This works fine.

I'm having trouble doing a database refresh. If I interactively select a
group shape (or the page) and from the main menus do database refresh,
nothing happens. If I click once to select the group shape and again to
subselect the shape that's linked to the database, then right-click, I can
select refresh and it works for that single shape.

I'm having a very difficult time getting this automated so that it happens
for all shapes when the document is opened, or on demand for all shapes. I
think a lot of this has to do with the grouping. I would greatly appreciate
any clues.

Bruce Hensley

 

[Chris Roth [ Visio MVP ]]

I tried writing a little sub to do this, but it didn't work as expected.
(see code after signature)

DataBase Wizard shapes have a right-click action in the ShapeSheet for
updating the shape from the database. It looks like this: RUNADDON("DBR")

My code gives me a weird error message that comes from the Database Wizard:

Error message
Cannot read the link information stored in teh shape. Run the Database
Wizard and re-link the shape to correct the problem.

If I simply right-clic the shape, it works fine.

Any Visio/MS guys out there have any ideas why we can't poke a .VSL via
automation?


--

Chris Roth
Visio MVP

---------------------------------------------------

Sub update()

' Get a shape. To do all shapes, make a recursive loop and look
' for shapes with actions rows that call the add-on, ie:
RunnAddOn("DBR")
Dim shp As Visio.Shape
Set shp = Visio.ActiveWindow.Selection(1)

' Get the add-on
Dim ao As Visio.Addon
Set ao = Visio.Addons("DBR")

' Build a command line string:
Dim args As String
args = "/visio=instancehandle32 /doc=docIndex /page=pagIndex
/shape=Nameid"
args = Replace(args, "instancehandle32",
Visio.Application.WindowHandle32)
args = Replace(args, "docIndex", shp.Document.Index)
args = Replace(args, "pagIndex", shp.ContainingPage.Index)
args = Replace(args, "Nameid", shp.NameID)
Debug.Print args

ao.Run args
' I've also tried with an empty argument string: ao.Run ""
' This also gave the bad message.

End Sub

 

[Bruce Hensley]

Chris,

Thanks.

I feel validated. A couple of my attempts at doing it from code gave me the
same message ... once for every shape instance, not just the shapes with
database links.

The right-click code on mine is - RUNADDON("Database Refresh Shape") - so
that's what I was using instead of DBR.

Bruce

 

[Al Edlund]

this was offered quite awhile ago by another 'lurker'
Al
From Page 759 of Microsoft Visio Version 2002 Inside and Out book.



1) Tools / Macros/ Visio Extras / Database Wizard

2) Click Next

3) Select "Create A Linked Drawing or Modify An Existing One", and click

Next

4) Select "Add Database Actions And Events To a Drawing Page", and click

Next

5) Choose your Visio Drawing and page

6) Check the "Refresh linked shapes on document open", and click Next

7) Click Finish



I tried this out a while back and was disappointed because you have to do

this for every page that contains a linked shape and my visio document

contained more than a hundred pages. So wrote a macro that loops through

all pages refreshes them with the database. I'm sure there is a way to make

the macro run when the document opens although I don't know what it is off

hand. Hope this helps.





' DatabaseRefresh

'

' This macro loops through all pages of your visio document and

' performs a Database Refresh by executing the Addon for refreshing

' the database ("Database Refresh").

Public Sub DatabaseRefresh()

Dim pg As Visio.Page

Dim OriginalPg As Visio.Page



' Record the original page

Set OriginalPg = ActiveWindow.Page



' Loop through each page of the document

For Each pg In ThisDocument.Pages



' Set the page to be the active page

ActiveWindow.Page = pg.Name



' Execute the "Database Refresh" Addon

Application.Addons("Database Refresh").Run ""



' Increment the page counter

Next pg



' Set the active page back to the original one so the

' user doesn't end up on the last page

ActiveWindow.Page = OriginalPg.Name



End Sub

 

[Chris Roth [ Visio MVP ]]

Well I tried the example code, and this works works for me:

Visio.Application.Addons("Database Refresh").Run ""

Then I tried something interesting on the VBA command line:

?Visio.Addons("Database Refresh").NameU
DBRS

But the ShapeSheet formula calls "DBR".

Very weird.

Command line analysis is even funner if you see it all together:

? Visio.Addons("Database Refresh").NameU --> DBRS
? Visio.Addons("Database Refresh").Name --> Database Refresh

? Visio.Addons("Database Refresh Shape").NameU --> DBR
? Visio.Addons("Database Refresh Shape").Name --> Database Refresh Shape

? Visio.Addons("DBR").NameU --> DBR
? Visio.Addons("DBR").Name --> Database Refresh Shape

? Visio.Addons("DBRS").NameU --> DBRS
? Visio.Addons("DBRS").Name --> Database Refresh

You can see that there are two add-ons:

DBR - Database Refresh
DBRS - Database Refresh Shape

There is probably something going on with Alternative Names and the
solutions PublishComponent table. I don't know....

--

Hope this helps,

Chris Roth
Visio MVP

 

[Bruce Hensley]

Al,

I tried this, and it did not work. I also found your code for running it
against all pages and tried to run it on document open, but it didn't work
either.

Thanks though for your response.

Bruce

 

[Bruce Hensley]

Chris,

Thanks. I'm not quite sure how to take what you've done and make it work
for me. Below is my code. The 'message' text shows me that it is
effectively iterating through all the shapes and recognizing those with the
database links. However, the data in the shapes is still not refreshed. I
can, however, click on a group, then click again to subselect the shape with
db links, and then right-click to do a successful database refresh.

For some reason, I thought that "Database Refresh" refreshed all shapes in
the page, as Al points out, and "Database Refresh Shape" refreshes the
selected shape. I was thinking my problem with the former was that the
database shapes were shapes within groups and my problem with the latter was
in how to select the shape within a shape.

Bruce
-----------------------------

'in ThisDocument document
Private Sub Document_DocumentOpened(ByVal doc As IVDocument)
Dim message As String
RefreshShapes10 ActivePage.Shapes, message
MsgBox (message)
End Sub

'in General module
Sub RefreshShapes10(Shapes As Visio.Shapes, message As String)
Dim vshape As Shape
For Each vshape In Shapes
If vshape.Type = visTypeGroup Then
RefreshShapes10 vshape.Shapes, message 'recurse for groups
message = message & "group" & vbCrLf
Else
If vshape.CellExists("User.Command1", 0) = True Then
'The shapes of interest have cell User.Command1
Visio.Application.Addons("Database Refresh").Run ""
message = message & "DB shape" & vbCrLf
Else
message = message & "non-DB shape" & vbCrLf
End If
End If
Next
End Sub

Well I tried the example code, and this works works for me:

Visio.Application.Addons("Database Refresh").Run ""

Then I tried something interesting on the VBA command line:

?Visio.Addons("Database Refresh").NameU
DBRS

But the ShapeSheet formula calls "DBR".

Very weird.

Command line analysis is even funner if you see it all together:

? Visio.Addons("Database Refresh").NameU --> DBRS
? Visio.Addons("Database Refresh").Name --> Database Refresh

? Visio.Addons("Database Refresh Shape").NameU --> DBR
? Visio.Addons("Database Refresh Shape").Name --> Database Refresh Shape

? Visio.Addons("DBR").NameU --> DBR
? Visio.Addons("DBR").Name --> Database Refresh Shape

? Visio.Addons("DBRS").NameU --> DBRS
? Visio.Addons("DBRS").Name --> Database Refresh

You can see that there are two add-ons:

DBR - Database Refresh
DBRS - Database Refresh Shape

There is probably something going on with Alternative Names and the
solutions PublishComponent table. I don't know....

--

Hope this helps,

Chris Roth
Visio MVP

<... quoted material deleted ...>

 

[Bruce Hensley]

Code sample 1, below, placed in the General module has always worked when it
is executed with CALLTHIS from EventDrop of the shape [with
RUNADDON("Database Select Record") in User.Command1]. This is how I create
the shape and set the database link in the first place.

Borrowing this for the refresh did not work either, using the code in sample
2 and either RUNADDON("Database Refresh") or RUNADDON("Database Refresh
Shape") in User.Command2. I see a quick flash of the database wizard icon,
and all shapes are hit, but shapes are not refreshed.

Getting desperate!!! Any help greatly appreciated!!!!

Bruce
----------------
' Sample 1:

Private Sub AddPosition(ByVal Shape As IVShape)
'Run by CALLTHIS("AddPosition") in the EventDrop event for the shape

Dim shpPic As Visio.Shape 'shape to hold picture
Dim cellobj As Cell
' .. extra code deleted

Dim pagObj As Visio.Page
Set pagObj = Visio.ActiveDocument.Pages(1)

Dim slct As Selection
Set slct = Visio.ActiveWindow.Selection

'Select the database record for the shape
'The cell User.Command1 contains RUNADDON("Database Select Record")
Set cellobj = Shape.Cells("User.Command1")
cellobj.Trigger

' .. and so on

--------------
' Sample 2

Sub RefreshShapes12(Shapes As Visio.Shapes, message As String)
Dim vshape As Shape
Dim cellobj As Cell
For Each vshape In Shapes
If vshape.Type = visTypeGroup Then
RefreshShapes12 vshape.Shapes, message 'recurse for groups
message = message & "group" & vbCrLf
Else
If vshape.CellExists("User.Command1", 0) = True Then
'The shapes of interest have cell User.Command1
Set cellobj = vshape.Cells("User.Command2")
cellobj.Trigger
message = message & "DB shape" & vbCrLf
Else
message = message & "non-DB shape" & vbCrLf
End If
End If
Next
End Sub

Chris,

Thanks. I'm not quite sure how to take what you've done and make it work
for me. Below is my code. The 'message' text shows me that it is
effectively iterating through all the shapes and recognizing those with the
database links. However, the data in the shapes is still not refreshed. I
can, however, click on a group, then click again to subselect the shape with
db links, and then right-click to do a successful database refresh.

For some reason, I thought that "Database Refresh" refreshed all shapes in
the page, as Al points out, and "Database Refresh Shape" refreshes the
selected shape. I was thinking my problem with the former was that the
database shapes were shapes within groups and my problem with the latter was
in how to select the shape within a shape.

Bruce
-----------------------------

'in ThisDocument document
Private Sub Document_DocumentOpened(ByVal doc As IVDocument)
Dim message As String
RefreshShapes10 ActivePage.Shapes, message
MsgBox (message)
End Sub

'in General module
Sub RefreshShapes10(Shapes As Visio.Shapes, message As String)
Dim vshape As Shape
For Each vshape In Shapes
If vshape.Type = visTypeGroup Then
RefreshShapes10 vshape.Shapes, message 'recurse for groups
message = message & "group" & vbCrLf
Else
If vshape.CellExists("User.Command1", 0) = True Then
'The shapes of interest have cell User.Command1
Visio.Application.Addons("Database Refresh").Run ""
message = message & "DB shape" & vbCrLf
Else
message = message & "non-DB shape" & vbCrLf
End If
End If
Next
End Sub

< ... quoted material deleted ...>

 

[Chris Roth [ Visio MVP ]]

Cell.Trigger! I forgot. Have you tried that?

We know that the right-mouse clicks work for your shapes. How about getting
the cell that has the right-mouse Action that you are looking for, and
trying cell.Trigger on that?

- Chris

Code sample 1, below, placed in the General module has always worked when it
is executed with CALLTHIS from EventDrop of the shape [with
RUNADDON("Database Select Record") in User.Command1]. This is how I create
the shape and set the database link in the first place.

Borrowing this for the refresh did not work either, using the code in sample
2 and either RUNADDON("Database Refresh") or RUNADDON("Database Refresh
Shape") in User.Command2. I see a quick flash of the database wizard icon,
and all shapes are hit, but shapes are not refreshed.

Getting desperate!!! Any help greatly appreciated!!!!

Bruce
----------------
' Sample 1:

Private Sub AddPosition(ByVal Shape As IVShape)
'Run by CALLTHIS("AddPosition") in the EventDrop event for the shape

Dim shpPic As Visio.Shape 'shape to hold picture
Dim cellobj As Cell
' .. extra code deleted

Dim pagObj As Visio.Page
Set pagObj = Visio.ActiveDocument.Pages(1)

Dim slct As Selection
Set slct = Visio.ActiveWindow.Selection

'Select the database record for the shape
'The cell User.Command1 contains RUNADDON("Database Select Record")
Set cellobj = Shape.Cells("User.Command1")
cellobj.Trigger

' .. and so on

--------------
' Sample 2

Sub RefreshShapes12(Shapes As Visio.Shapes, message As String)
Dim vshape As Shape
Dim cellobj As Cell
For Each vshape In Shapes
If vshape.Type = visTypeGroup Then
RefreshShapes12 vshape.Shapes, message 'recurse for groups
message = message & "group" & vbCrLf
Else
If vshape.CellExists("User.Command1", 0) = True Then
'The shapes of interest have cell User.Command1
Set cellobj = vshape.Cells("User.Command2")
cellobj.Trigger
message = message & "DB shape" & vbCrLf
Else
message = message & "non-DB shape" & vbCrLf
End If
End If
Next
End Sub

Chris,

Thanks. I'm not quite sure how to take what you've done and make it work
for me. Below is my code. The 'message' text shows me that it is
effectively iterating through all the shapes and recognizing those with the
database links. However, the data in the shapes is still not refreshed. I
can, however, click on a group, then click again to subselect the shape with
db links, and then right-click to do a successful database refresh.

For some reason, I thought that "Database Refresh" refreshed all shapes in
the page, as Al points out, and "Database Refresh Shape" refreshes the
selected shape. I was thinking my problem with the former was that the
database shapes were shapes within groups and my problem with the latter was
in how to select the shape within a shape.

Bruce
-----------------------------

'in ThisDocument document
Private Sub Document_DocumentOpened(ByVal doc As IVDocument)
Dim message As String
RefreshShapes10 ActivePage.Shapes, message
MsgBox (message)
End Sub

'in General module
Sub RefreshShapes10(Shapes As Visio.Shapes, message As String)
Dim vshape As Shape
For Each vshape In Shapes
If vshape.Type = visTypeGroup Then
RefreshShapes10 vshape.Shapes, message 'recurse for groups
message = message & "group" & vbCrLf
Else
If vshape.CellExists("User.Command1", 0) = True Then
'The shapes of interest have cell User.Command1
Visio.Application.Addons("Database Refresh").Run ""
message = message & "DB shape" & vbCrLf
Else
message = message & "non-DB shape" & vbCrLf
End If
End If
Next
End Sub

< ... quoted material deleted ...>

 

[Rose]

Bruce, did you crack it? I am trying to do something very similar, and have foun

1) the page refresh (using DBRS / "Database Refresh") works great, so looping through all pages with DBR refreshes all pages. How you do this on startup, however, I have now ide

2) looping through all shapes on all pages (using DBR / "Database Refresh Shapes") doesn't work UNLESS you identify all the shapes that actually have a link, and ONLY execute the DBR for those. Now......if I could only figure out how I figure out whether a shape has a DB link!!

Someone no doubt will post the answers here before long......

 

[Al Edlund]

Rose,
quick question, since I don't use the wizard but rather do all of my db
stuff directly, have you looked at the shape sheets of those shapes
connected to the database. Specifically I would be looking for either a
custom property or a user field with a flag that indicates db connectivity.
Al

Bruce, did you crack it? I am trying to do something very similar, and have found

1) the page refresh (using DBRS / "Database Refresh") works great, so

looping through all pages with DBR refreshes all pages. How you do this on
startup, however, I have now idea

2) looping through all shapes on all pages (using DBR / "Database Refresh

Shapes") doesn't work UNLESS you identify all the shapes that actually have
a link, and ONLY execute the DBR for those. Now......if I could only figure
out how I figure out whether a shape has a DB link!!

 

[rose]

Yes, Al, looking at the shape sheet actually made me realise that some shapes have ODBC connection information and others haven't (probably obvious to someone who isn't a Visio newbie, like I am ...LOL

I have now figured out some VBA code (am not a programming - whizzkid, either so this was major progress...), using the CellExists command, and I can now distinguish between the shapes that are linked to the Access DB, and those that are not, yepeeh

But the excitement didn't last - - the DBR / "Database Shape Refresh" function still doesn't work against those linked shapes. Still getting the message that I should use the DB wizzard to re-create the links.....which is a red herring, since a right-click on the linked shapes executes the DBR perfectly ok

My latest theory is now that the DBR function needs, in VBA, a bit more information about the database it is meant to read, and perhaps also keys for the read. Not a clue where to start to confirm this theory.......

My VERY BEST theory is, however, that one of the Microsoft/Visio guys lurking here would have some extremely happy customers (upgraded from pretty p*****d customers) if they just posted the working VBA here

 

[David Parker]

OK, Chris is on the right track.
Here is the code I use (now let's hope that Microsoft fix the bug):-

Public Sub RefreshLinkedShapes(byref mdocVisio as Visio.Document)
'RUNADDON("DBRS")
On Error GoTo errHandler
Dim pag As Visio.Page
Dim adn As Visio.Addon
Dim sAddon As String
Dim bExists As Boolean
Dim sCurrentPage As String
Dim iConfirm As Integer
Dim shp As Visio.Shape

sAddon = "Database Refresh"

For Each adn In mdocVisio.Application.Addons
'Debug.Print adn.Index, adn.Name, adn.NameU
If adn.Name = sAddon Then
bExists = True
Exit For
End If
Next adn

'Read the current page name
sCurrentPage = mdocVisio.Application.ActiveWindow.Page
If bExists Then
iConfirm = MsgBox("Do you want to refresh all linked shapes now?",
vbQuestion + vbYesNo, App.ProductName)
If iConfirm = vbYes Then
'Loop thru all pages and run the add-on
For Each pag In mdocVisio.Pages
If pag.Application.Version < 11 Then
mdocVisio.Application.ActiveWindow.Page = pag.Name
adn.Run ""
Else
For Each shp In pag.Shapes
If shp.CellExists("User.ODBCConnection",
Visio.visExistsAnywhere) Then
If shp.Cells("EventDrop").Formula =
"RUNADDON(""DBR"")" Then
shp.Cells("EventDrop").Trigger
End If
End If
Next shp
End If
Next pag
'Reset back to original page
mdocVisio.Application.ActiveWindow.Page = sCurrentPage
End If
Else
MsgBox "The Database Wizard does not appear to be loaded!",
vbExclamation, App.ProductName
End If

exitHere:
Exit Sub

errHandler:
MsgBox "RefreshLinkedShapes : " & Err.Description, vbInformation,
App.ProductName
Resume exitHere
End Sub

Yes, Al, looking at the shape sheet actually made me realise that some

shapes have ODBC connection information and others haven't (probably obvious
to someone who isn't a Visio newbie, like I am ...LOL)

I have now figured out some VBA code (am not a programming - whizzkid,

either so this was major progress...), using the CellExists command, and I
can now distinguish between the shapes that are linked to the Access DB, and
those that are not, yepeeh!

But the excitement didn't last - - the DBR / "Database Shape Refresh"

function still doesn't work against those linked shapes. Still getting the
message that I should use the DB wizzard to re-create the links.....which is
a red herring, since a right-click on the linked shapes executes the DBR
perfectly ok.

My latest theory is now that the DBR function needs, in VBA, a bit more

information about the database it is meant to read, and perhaps also keys
for the read. Not a clue where to start to confirm this theory........

My VERY BEST theory is, however, that one of the Microsoft/Visio guys

lurking here would have some extremely happy customers (upgraded from pretty
p*****d customers) if they just posted the working VBA here!

 

[Rose]

Brilliant, David, this works great! (though I had to make some small mods because my EventDrop wasn't set to DBR)

Only snag now is that if a database record isn't found, the DBR AddOn produces a message that isn't too helpful (shape name only, no page info). I would like to change the background color of the affected shape, say to red (or even delete the affected shape), but I can't figure out how I can capture which of the shapes DBR couldn't process.......any ideas?

 

[Al Edlund]

Rose,
I use an error handler that looks something like this for db operations. The
strGUID is the shape ID and is assigned when I touch the shape (i.e. strABC
= .shp.Name in David's example). The usually allows me to identify the
return code I want to handle and call any other routines necessary to clean
it up.
Al

SaveErr = Err.Number
If SaveErr <> 0 Then
Debug.Print "Err in subDiscreteFieldUpdate is " & Err & " " &
Err.Description
Debug.Print strGUID & " " & strField & " " & strValue

For Each errDB In cnn.Errors
Debug.Print "DB Update " & " " & strGUID & " " & strField & " "
& strValue
Debug.Print "DB Description: " & errDB.Description
Debug.Print "DB Number: " & errDB.Number & " (" & _
Hex$(errDB.Number) & ")"
Debug.Print "JetErr: " & errDB.SQLState
Next
' Resume DiscreteField_Exit:
End If

Brilliant, David, this works great! (though I had to make some small mods

because my EventDrop wasn't set to DBR).

Only snag now is that if a database record isn't found, the DBR AddOn

produces a message that isn't too helpful (shape name only, no page info). I
would like to change the background color of the affected shape, say to red
(or even delete the affected shape), but I can't figure out how I can
capture which of the shapes DBR couldn't process.......any ideas?

 

[Bruce Hensley]

Chris,

I was out a few days, and a colleague pegged it for me. The code is below;
he must have been reading your mind. However, we still can't get it to run
as an on open event, so he added it as a rightclick option for the page ...
good enough for our needs.

Thanks again,
Bruce Hensley
---------------------------
Private Sub UpdateFields()
Dim oShape As Visio.Shape
Dim oSubShape As Visio.Shape
Dim oPage As Visio.Page
Dim oCell As Cell

Set oPage = Visio.ActiveDocument.Pages(1)
For Each oShape In oPage.Shapes
If oShape.Type = 2 Then
For Each oSubShape In oShape.Shapes
If oSubShape.CellExists("Prop.PosNr", 0) Then
'This is how we recognize the right shapes
Set oCell = oSubShape.Cells("Actions.Action[2]")
'The second rightclick action is the refresh
oCell.Trigger
End If
Next oSubShape
End If
Next oShape

Set oCell = Nothing
Set oSubShape = Nothing
Set oShape = Nothing
Set oPage = Nothing

MsgBox "All fields have been updated."
End Sub

Cell.Trigger! I forgot. Have you tried that?

We know that the right-mouse clicks work for your shapes. How about getting
the cell that has the right-mouse Action that you are looking for, and
trying cell.Trigger on that?

- Chris

<...attachments deleted ...>

 

[Bruce Hensley]

Rose,

Glad you got some help from David. I posted our solution too.


David,

Does this work for shapes within groups?

Thanks,
Bruce