Option Explicit ' Create a Visio drawing from a TeamTrack workflow or project. ' Query the GWE (Graphical Workflow Environment) tables in the TeamTrack ' database and roughly duplicate the layout found there. ' Also need to query States and Transitions tables to determine logical ' connection information so that Visio "connectors" may link Visio ' objects. ' ** ********************************************************************* ' ** $Id$ ' ** $Change$ ' ** $DateTime$ ' ** $Author$ ' ** ********************************************************************* ' Define the connection as a constant. ' This is for a TNS-less Oracle ' Public CONST DB_CONNECTION="Driver={Microsoft ODBC for Oracle}; " & _ ' "CONNECTSTRING=(DESCRIPTION=" & _ ' "(ADDRESS=(PROTOCOL=TCP)" & _ ' "(HOST=mysrv)(PORT=7001))" & _ ' "(CONNECT_DATA=(SERVICE_NAME=MYDB))); uid=read;pwd=read;" ' Other possible databases are MS-Access, SQL Server, and (theoretically) MySql. ' Public CONST DB_CONNECTION="PROVIDER=SQLOLEDB;SERVER=your_server;DATABASE=your_db;UID=your_login;PWD=your_password" ' Public CONST DB_CONNECTION="Driver={Microsoft Access Driver(*.mdb)};Dbq=path_to_MDB_file;Uid=Admin;Pwd=;" ' Public CONST DB_CONNECTION="Provider = Microsoft.Jet.OLEDB.4.0; Data Source=path_to_MDB_file;" 'CONST DB_CONNECTION="Driver={SQL Server};Server=someserver.somewhere.com;Database=some_database;Uid=some_user;Pwd=some_password;" ' *************************************************************************** ' Print some basic stuff WScript.echo "WScript.Version=" & WScript.Version & " WScript.BuildVersion=" & WScript.BuildVersion WScript.echo "WScript.Name = " & WScript.Name WScript.echo "WScript.FullName = " & WScript.FullName WScript.echo "WScript.Path = " & WScript.Path WScript.echo "WScript.ScriptName = " & WScript.ScriptName WScript.echo "WScript.ScriptFullName = " & WScript.ScriptFullName Dim wshShell Set wshShell = WScript.CreateObject("WScript.Shell") WScript.echo "WShell.CurrentDirectory = " & wshShell.CurrentDirectory ' *************************************************************************** ' Print env vars as 'name=value' Dim wshEnv , env Set wshEnv = wshShell.Environment WScript.echo "wshShell.Environment.count=" & wshShell.Environment.count For each env in wshEnv WScript.echo "Environment item '" & env & "'" next ' Get the name of the Workflow or Project dim objArgs , I Set objArgs = WScript.Arguments For I = 0 to objArgs.Count - 1 WScript.Echo objArgs(I) Dim dctWkflo ' ReadWorkflow will return a Dictionary object. Set dctWkflo = ReadWorkflow(objArgs(I)) Next ' *************************************************************************** ' *************************************************************************** Function ReadWorkflow(strProj_Wkflo) Dim objAdoDbConnection, objRecSet Set objAdoDbConnection = WScript.CreateObject("ADODB.Connection") objAdoDbConnection.Open DB_CONNECTION Set objRecSet = WScript.CreateObject("ADODB.recordset") dim strQuery,strWkflo_name,nWkflo_id,strTbl_name,nTbl_id,strPrj_name,nPrj_id If LCase(Left(strProj_Wkflo,9)) = "workflow." Then strQuery="select wf.ts_id,wf.ts_name,wf.ts_tableid,tbl.ts_name from ts_workflows wf,ts_tables tbl where wf.ts_tableid=tbl.ts_id AND lower(wf.ts_name) like '" & mid(strProj_Wkflo,8) & "'" WScript.Echo "Query for workflow=" & strQuery objRecSet.open strQuery, objAdoDbConnection, 3,3 objRecSet.MoveFirst strWkflo_name=objRecSet("wf.ts_name") nWkflo_id=objRecSet("wf.ts_id") strTbl_name=objRecSet("tbl.ts_name") nTbl_id=objRecSet("wf.ts_tableid") strPrj_name="" nPrj_id="" WScript.Echo "strWkflo_name=" & strWkflo_name & ";" & "nWkflo_id=" & nWkflo_id & ";" & "strTbl_name=" & _ strTbl_name & ";" & "nTbl_id=" & nTbl_id & ";" & "strPrj_name=" & strPrj_name & ";" & "nPrj_id=" & nPrj_id ElseIf LCase(Left(strProj_Wkflo,8)) = "project." then strQuery="select prj.ts_id,prj.ts_name,prj.ts_workflowid,wf.ts_ts_name,wf.ts_tableid,tbl.ts_name from ts_projects prj,ts_workflows wf,ts_tables tbl where prj.ts_workflowid=wf.ts_id AND wf.ts_tableid=tbl.ts_id AND lower(prj.ts_name) like '" & mid(strProj_Wkflo,8) & "'" WScript.Echo "Query for project=" & strQuery objRecSet.open strQuery, objAdoDbConnection, 3,3 objRecSet.MoveFirst strWkflo_name=objRecSet("wf.ts_name") nWkflo_id=objRecSet("prj.ts_workflowid") strTbl_name=objRecSet("tbl.ts_name") nTbl_id=objRecSet("wf.ts_tableid") strPrj_name=objRecSet("prj.ts_name") nPrj_id=objRecSet("prj.ts_id") WScript.Echo "strWkflo_name=" & strWkflo_name & ";" & "nWkflo_id=" & nWkflo_id & ";" & "strTbl_name=" & _ strTbl_name & ";" & "nTbl_id=" & nTbl_id & ";" & "strPrj_name=" & strPrj_name & ";" & "nPrj_id=" & nPrj_id Else WScript.Echo "No such Project or Workflow: '" & strProj_Wkflo & "'" set ReadWorkflow=nothing exit function End if objRecSet.Close Set objRecSet = Nothing objAdoDbConnection.Close Set objAdoDbConnection = Nothing Set ReadWorkflow=Nothing end function ' snarfed from the web ' --------------------------------------------------------------------------- ' SQL Server Database Connection String using SQL Server Driver (DSN less) ' ' <%@LANGUAGE=VBSCRIPT%> ' <% ' Option Explicit ' Dim strConnection, conn, rs, strSQL ' ' strConnection = "Driver={SQL Server};Server=SQLServerName;" & _ ' "Database=DBaseName;Uid=sa;Pwd=password;" ' ' Set conn = Server.CreateObject("ADODB.Connection") ' conn.Open strConnection ' ' Set rs = Server.CreateObject("ADODB.recordset") ' strSQL = "SELECT * FROM myTable" ' rs.open strSQL, conn, 3,3 ' ' rs.MoveFirst ' WHILE NOT rs.EOF ' Response.Write(rs("myField") & "
") ' rs.MoveNext ' WEND ' ' rs.Close ' Set rs = Nothing ' ' conn.Close ' Set conn = Nothing ' %> ' --------------------------------------------------------------------------- ' also snarfed from the web ' --------------------------------------------------------------------------- ' Public Sub CreateDrawing() ' ' Dim shpObjHUB As Visio.Shape ' Dim shpObjNodes As Visio.Shape ' Dim shpObjConnector As Visio.Shape ' Dim mstObjConnector As Visio.Master ' Dim mstObj As Visio.Master ' Dim stnObj As Visio.Document ' Dim dX, dY As Double ' Dim dDegreeInc As Double ' Dim dRad As Double ' Dim dPageWidth, dPageHeight As Double ' Dim i As Integer ' ' Const PI = 3.1415 ' Const CircleRadius = 2 ' ' Dim arrNetData() As String ' ' 'Read data. ' InitData arrNetData ' ' 'To place shapes in even increments around the circle, ' 'divide 360 by the total number of items in the array. ' dDegreeInc = 360 / UBound(arrNetData) ' ' 'Read the PageWidth and PageHeight properties. ' dPageWidth = ActivePage.PageSheet.Cells("PageWidth").ResultIU ' dPageHeight = ActivePage.PageSheet.Cells("PageHeight").ResultIU ' ' 'Open the Basic Network Shapes 3D Stencil. ' Set stnObj = Application.Documents.OpenEx("Basic Network Shapes 3D.vss", visOpenDocked) ' ' 'Process the hub shape. ' Set mstObj = stnObj.Masters(arrNetData(0, 0)) ' Set shpObjHUB = ActivePage.Drop(mstObj, dPageWidth / 2, dPageHeight / 2) ' ' 'Set the text of the hub shape. ' shpObjHUB.Text = arrNetData(0, 1) ' ' 'Get the Connector master. ' Set mstObjConnector = stnObj.Masters("Bottom to Top Angled") ' ' 'Process the nodes. ' For i = 1 To UBound(arrNetData) ' Set mstObj = stnObj.Masters(arrNetData(i, 0)) ' 'Determine X, Y location for placement (in circle around hub). ' dRad = (dDegreeInc * i) * PI / 180 ' dX = CircleRadius * Cos(dRad) + (dPageWidth / 2) ' dY = CircleRadius * Sin(dRad) + (dPageHeight / 2) ' 'Add shape to drawing in proper location. ' Set shpObj = ActivePage.Drop(mstObj, dX, dY) ' 'Set shape text. ' shpObj.Text = arrNetData(i, 1) ' ' 'Connect the current node to the hub. ' Set shpObjConnector = ActivePage.Drop(mstObjConnector, 0, 0) ' shpObjConnector.SendToBack ' 'Glue the begin point to the hub shape. ' shpObjConnector.Cells("BeginX").GlueTo shpObjHUB.Cells("Connections.X1") ' 'Glue the end point to the node that was just added. ' shpObjConnector.Cells("EndX").GlueTo shpObj.Cells("Connections.X1") ' Next ' End Sub ' --------------------------------------------------------------------------- ' As of now, this function is not called. It just creates a simple one-object ' Visio and saves it. Strictly proof-of-concept until I get the table queries ' working and can return actual usable data. Function CreateVisio(dctWf) Dim objVisioApp 'As Visio.Application ' Declare an Instance of Visio. Dim objVisioDocumentsCollection 'As Visio.Documents ' Documents collection of instance. Dim objVisioDocument 'As Visio.Document ' Document to work in. Dim objVisioStencil 'As Visio.Document ' Stencil that contains master. Dim objVisioMaster 'As Visio.Master ' Master to drop. Dim objVisioPagesCollection 'As Visio.Pages ' Pages collection of document. Dim objVisioPage 'As Visio.Page ' Page to work in. Dim objVisioShape 'As Visio.Shape ' Instance of master on page. ' Create an instance of Visio and create a document based on the ' Basic Diagram template. It doesn't matter if an instance of ' Visio is already running, CreateObject will run a new one. set objVisioApp = WScript.CreateObject("Visio.Application") dim objInvisibleVisioApp set objInvisibleVisioApp = WScript.CreateObject("Visio.InvisibleApp") Set objVisioDocumentsCollection = objVisioApp.Documents ' Create a document based on the Basic Diagram template that ' automatically opens the Basic Shapes stencil. Set objVisioDocument = objVisioDocumentsCollection.Add("Basic Diagram.vst") Set objVisioPagesCollection = objVisioApp.ActiveDocument.Pages ' A new document always has at least one page, whose index in the ' Pages collection is 1. Set objVisioPage = objVisioPagesCollection.Item(1) Set objVisioStencil = objVisioApp.Documents("Basic Shapes.vss") Set objVisioMaster = objVisioStencil.Masters("Rectangle") ' Drop the rectangle in the approximate middle of the page. ' Coordinates passed with the Drop method are always inches. Set objVisioShape = objVisioPage.Drop(objVisioMaster, 4.25, 5.5) ' Set the text of the rectangle. objVisioShape.Text = "This is some text." ' Save the drawing and quit Visio. The message pauses the program ' so you can see the Visio drawing before the instance closes. objVisioDocument.SaveAs "c:\MyDrawing.vsd" MsgBox "Drawing saved as 'c:\MyDrawing.vsd'", , "AutoVisio (OLE) Example" ' Quit Visio. objVisioApp.Quit ' Clear the variable from memory. Set objVisioApp = Nothing set CreateVisio=nothing end function