Using VBA (Visio 2003) to Read & Write to a MS Access DataBase

[Leland]

I would like to use VBA (in Visio 2003) to read from and write to a MS
Access DataBase but am not sure where to start. Could someone recommend a
book or website to get me started? I know I could use the supplied AddOns
but I need more than they can supply.

Thanks,
Dave

 

[John Marshall, MVP]

There are three main books; DVS, Dave Edson's book and Graham Wideman's book
(more information at the bottom of
http://www.mvps.org/visio/Information_Sites.htm)

John... Visio MVP

Need stencils or ideas? http://www.mvps.org/visio/3rdparty.htm
Need VBA examples? http://www.mvps.org/visio/VBA.htm
Common Visio Questions http://www.mvps.org/visio/common_questions.htm

 

[Russ McKenna]

Okay, instead of a book, just look on VB sites for writing and reading to a
database.

To get you started - this is one way of 1000's, and written from memory - so
I may have left some stuff out.
1) Create a new database, call it MB1.mdb
2) create a new table, call it myTable
3) In that table define 2-4 fields, try "PartNumber", "Description", "Cost",
"Quantity"
4) set the fields to text, text, currency, single
This is just sample

Now in Visio vba
1) goto Tools -> References
2) Add a refernce to Microsoft DAO
3) Add the folllowing routine to your code

Public sub MySub()
Dim rstTemp As dao.Recordset
Dim dbsDatabase As dao.Database

Set dbsDatabase = OpenDatabase("c:\MB1.mdb", False, True) 'make sure all
path info is included for the database name
Set rstTemp = dbsDatabase.OpenRecordset("SELECT * FROM " & myTable )
If rstTemp.RecordCount > 0 Then
msgbox "able to load database"
endif
end sub

 

[Matt B]

Dave,

Below is some code which was posted by 'Al Edlund' in responce to a similar
question I asked on microsoft.public.visio.database.modeling. I found it
particularly useful for a number of reasons, including the use of SQL to
query the database, the use of ADO and his informative error reporting. You
will also notice Al uses a custom property cell in Visio to store his
database location.

Below that is a simple ADO example, using SQL to query the database.

I recently purchased the Microsoft Access 2003 Bible - Praque, Irwin,
Reardon - Wiley Press - ISBN: 0-7645-3986-8. I found this book VERY useful
as it included sections on DAO, ADO SQL and the considerations you need to
make when designing a database. While this book is specifically written for
Access the ADO, DAO SQL code may be used in Visio.

Also, try a Google search for words such as 'ADO Explained', 'ADO
Tutorial', 'Learn ADO', 'ADO Explained', 'ADO Access Tutorial'. I found some
of the best references and answers to my questions this way.
Some Links I found this way:
http://www.juicystudio.com/tutorial/vb/database.asp
http://msdn.microsoft.com/library/en-us/dnado/html/mstn_workshp1.asp?frame=true
http://mis.bus.sfu.ca/tutorials/MSAccess/tutorials/dao_intr.pdf

Hope this Help's
M@



' Dont forget to include the ADO Reference in VB (earlier replies to your
post explain this)
------Author: Al Edlund -------
' this subroutine creates a database record using a passed string
' GUID (usually from the pagObj_ShapeAdded event defined in ThisDocument)

Public Sub subCreateDbRecord(strDbTable As String, strIndex As String,
strGUID As String)

Dim intResult As Integer
Dim str_db_filename As String
Dim db As Database
Dim visDocument As Visio.Document
Dim visPage As Visio.Page
Dim SaveErr As Long
Dim errDB As ADODB.Error


Dim cnn As New ADODB.Connection
Dim rst As New ADODB.Recordset

Dim strProvider As String
Dim strSource As String
Dim strConn As String
Dim strSelect As String
strProvider = "PROVIDER=Microsoft.Jet.OLEDB.4.0;"
strSource = "Data Source="
Dim strProviderED As String ' the end delimter
strProviderED = ";"

On Error GoTo CreateRecord_Err

' first we have to find out which database is associated with this
document
' it is stored in a custom property on the sheet named "project
definition"
Set visDocument = Visio.ActiveDocument
Set visPage = visDocument.Pages.item("Project Definition")
str_db_filename = visDocument.Path &
visPage.PageSheet.Cells("prop.database_file.value").ResultStr("")

' now create the connection string and open the database
strConn = strProvider & strSource & str_db_filename & strProviderED
cnn.Open strConn

' all shape properties will be saved in a table base on group
strSelect = "SELECT * FROM " & strDbTable
rst.Open strSelect, cnn, adOpenKeyset, adLockOptimistic

rst.AddNew
' when we create the record we only put the pointer into it
' we will update all of the fields in another routine
rst.Fields(strIndex) = strGUID

rst.Update

rst.Close
cnn.Close
DoEvents

CreateRecord_Exit:

Exit Sub

CreateRecord_Err:
SaveErr = Err.Number

If SaveErr > 0 Then
Debug.Print "Err in subCreateDbRecord is " & Err & " " & Err.Description
Resume Next
End If

For Each errDB In cnn.Errors
Debug.Print "DB Create"
Debug.Print "DB Description: " & errDB.Description
Debug.Print "DB Number: " & errDB.Number & " (" & _
Hex$(errDB.Number) & ")"
Debug.Print "JetErr: " & errDB.SQLState
Next

End Sub
---------------------------------------------------------

------------ My Simple ADO Example -----------------

Public Sub NewCableNumber(intCableNumber, strCableDescription,
intCableLength, strCableTypeID)
On Error GoTo NewCableNumber_Error

' Sub to Add a New Cable to the database.

Dim MyConn As ADODB.Connection ' ADODB Connection Object
Dim dbFullName As String ' Full Database Path & Name
dbFullName = "H:\Visio\Cable Record - Development 3\Database\cable.mdb"

' Create the Connetion to the Database
Set MyConn = New ADODB.Connection
MyConn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0; Data
Source=" _
& dbFullName & ";"

' Open the Database
MyConn.Open

' Execuite the SQL Statement Note the use of Variables in the SQL String
MyConn.Execute ("INSERT INTO tblCable(CableID, CableDescription,
CableLength, CableTypeID) VALUES('" & intCableNumber & "', '" &
strCableDescription & "', '" & intCableLength & "', '" & strCableTypeID &
"')")

' Close the Database
MyConn.Close

Exit Sub

NewCableNumber_Error:
MsgBox "Error is " & Err.Description & " in sub NewCableNumber.",
vbCritical, "System Error"

End Sub




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