Need to import table columns from flat file

[Bryan Murtha]

I have 725 field names, cut up across 7 files. I need to
import each one of these as a table into a database
diagram in Visio 2003 Professional. Although I have some
experience using VBA for Excel I've never used it for
Visio. Below is the macro I'm using to get the files out
of Excel. If somebody could just give me some pointers on
how I would modify it to import the files back into Visio.

Regards,
Bryan
Sub FlatFiler()

' close the file handle incase it's already open.

Close #1
Close #2
Close #3
Close #4
Close #5
Close #6
Close #7

Open "FlatSQLES" & Application.Text(Now(), "mmdd")
& ".TXT" For Output As #1
Open "FlatSQLCS" & Application.Text(Now(), "mmdd")
& ".TXT" For Output As #2
Open "FlatSQLCT" & Application.Text(Now(), "mmdd")
& ".TXT" For Output As #3
Open "FlatSQLPB" & Application.Text(Now(), "mmdd")
& ".TXT" For Output As #4
Open "FlatSQLSS" & Application.Text(Now(), "mmdd")
& ".TXT" For Output As #5
Open "FlatSQLSA" & Application.Text(Now(), "mmdd")
& ".TXT" For Output As #6
Open "FlatSQLGT" & Application.Text(Now(), "mmdd")
& ".TXT" For Output As #7

' get a handle on the worksheet
Set r = Worksheets(1).Range("b2:b726")

' loop through all the rows and seperate them into
different buckets(files)

For i = 1 To r.Rows.Count

' get a handle on the current row

Set thisRow = r.Rows(i)



Select Case thisRow.Cells(1, 2)

Case "ES"

Print #1, getFixBoolToChar(thisRow.Cells(1, 7),
thisRow.Cells(1, 5), thisRow.Cells(1, 6), thisRow.Cells
(1, 1))

Case "CS"

Print #2, getFixBoolToChar(thisRow.Cells(1, 7),
thisRow.Cells(1, 5), thisRow.Cells(1, 6), thisRow.Cells
(1, 1))

Case "CT"

Print #3, getFixBoolToChar(thisRow.Cells(1, 7),
thisRow.Cells(1, 5), thisRow.Cells(1, 6), thisRow.Cells
(1, 1))

Case "PB"

Print #4, getFixBoolToChar(thisRow.Cells(1, 7),
thisRow.Cells(1, 5), thisRow.Cells(1, 6), thisRow.Cells
(1, 1))

Case "SS"

Print #5, getFixBoolToChar(thisRow.Cells(1, 7),
thisRow.Cells(1, 5), thisRow.Cells(1, 6), thisRow.Cells
(1, 1))

Case "SA"

Print #6, getFixBoolToChar(thisRow.Cells(1, 7),
thisRow.Cells(1, 5), thisRow.Cells(1, 6), thisRow.Cells
(1, 1))

Case "GT"

Print #7, getFixBoolToChar(thisRow.Cells(1, 7),
thisRow.Cells(1, 5), thisRow.Cells(1, 6), thisRow.Cells
(1, 1))

End Select
Next

' Close the file handles
Close #1
Close #2
Close #3
Close #4
Close #5
Close #6
Close #7

End Sub

Private Function getFieldTypeAndLength(ByVal fieldType,
ByVal fieldLength)
Select Case fieldType
Case "Number": getFieldTypeAndLength = "varchar
(25)"
Case "Y/N": getFieldTypeAndLength = "varchar(4)"
Case "Text": getFieldTypeAndLength = "Varchar(" &
fieldLength & ")"
Case "Date": getFieldTypeAndLength = "varchar(25)"
End Select
End Function
Private Function getFixBoolToChar(ByVal fieldType, ByVal
tableName, ByVal fieldName, ByVal nbtaAlias)
If fieldType = "bit" Then
getFixBoolToChar = Chr(9)
& "dbo.convBoolToYesNo(" & tableName & "." & fieldName
& ")" & Chr(9) & " as " & nbtaAlias & Chr(44)
Else
getFixBoolToChar = Chr(9) & tableName & "." &
fieldName & Chr(9) & " as " & nbtaAlias & Chr(44)
End If
End Function
c

 

[junethesecond]

What would you mean by Application.Text( )?

 

[Bryan Murtha]

I don't really need that part. That is just part of the
Excel object model. I did find a visio example that I'm
trying to modify off the msdn. It creates a network shape
of hub. I'm trying to figure out how to get a handle on
the database table shape in the Database Model Diagram
stencil. As below:

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.
'Instead of a Network Shape I need to use a database
table.
Set stnObj = Application.Documents.OpenEx("Database
Model Diagram.vss", visOpenDocked)

'Process the hub shape.
'My question is how do I get a handle on the database
table shape in the above stencil
Set mstObj = stnObj.Masters(arrNetData(0, 0))
Set shpObjHUB = ActivePage.Drop(mstObj, dPageWidth /
2, dPageHeight / 2)

 

[Al Edlund]

this works for me. It's in vb.net and is tied to a sql server source but it
still can give you an idea of how you might make it work for you.
al

Public Sub VisioDrawCirclePicture()

Dim shpObjNode1 As Visio.Shape

Dim shpObjNode2 As Visio.Shape

Dim shpObjConn As Visio.Shape

Dim strNodeLayer As String

Dim strNodeName As String

Dim strSearch As String

Dim strSelect As String

Dim strStatus As String

Dim intRetVal As Integer

Dim celObjBeginX As Visio.Cell

Dim celObjEndX As Visio.Cell

Dim celObjPageWidth As Visio.Cell

Dim celObjPageHeight As Visio.Cell

Dim vsoWidth As Visio.Cell

Dim vsoHeight As Visio.Cell

Dim dblWidth As Double

Dim dblHeight As Double

Dim vsoCell As Visio.Cell



Dim szFaceString As String

Dim mstObj As Visio.Master

Dim mstObjConn As Visio.Master

Dim pagObj As Visio.Page

Dim pagShpObj As Visio.Shape

Dim stnObj1 As Visio.Document ' this is the device template

Dim dblX, dblY As Double

Dim dblDegreeInc As Double

Dim dblRad As Double

Dim dblPageWidth, dblPageHeight As Double

Dim dblObjSize As Double

Dim intI As Integer

Const PI = 3.1415

Const CircleRadius = 3.5

Dim sbParameters As New StringBuilder

Dim vsoLayers As Visio.Layers

Dim vsoLayer As Visio.Layer

Dim blnPreserveMembers As Boolean

Dim strCNN As String

strCNN = funcBuildConnString("vNetTrafSQL", _

"SQLOLEDB")

Dim objDA As OleDb.OleDbDataAdapter

Dim objCB As OleDb.OleDbCommandBuilder

Dim objTBL1 As Data.DataTable

Dim objTBL2 As Data.DataTable

Dim objROW1 As Data.DataRow

Dim objROW2 As Data.DataRow

Dim strSQL As String



Dim frmMain As frmAnchorMenu

' get the pointer to the anchor menu

frmMain = GetAnchorMenu()

' so that we can get the pointer to the active visio application

Dim visApp As Visio.Application 'Visio Application Object

visApp = frmMain.ParentVisioApplication

Dim sbStencil As New StringBuilder

sbStencil.Append(frmMain.txtApplicationDataPath.Text)

sbStencil.Append(frmMain.txtTemplate_VSS.Text)

' so that we can get the pointer to the active visio application

stnObj1 = visApp.Documents.OpenEx( _

sbStencil.ToString, _

visOpenDocked)

Try

trafForm.lblReportStatus.Text = " Identify objects for drawing "

' first we get the the names of the objects

strSelect = "SELECT tblVisioObjects.visObjName From tblVisioObjects GROUP BY
tblVisioObjects.visObjName"

objDA = New OleDb.OleDbDataAdapter(strSelect, strCNN)

objCB = New OleDb.OleDbCommandBuilder(objDA)

objTBL1 = New Data.DataTable

objDA.Fill(objTBL1)

' get the layers list from the page

vsoLayers = visApp.ActivePage.Layers

'Divide the circle by the number of objects in the array so they are spaced
equally

dblDegreeInc = 360 / objTBL1.Rows.Count

'Read the PageWidth and PageHeight properties

dblPageWidth = visApp.ActivePage.PageSheet.Cells("PageWidth").ResultIU

dblPageHeight = visApp.ActivePage.PageSheet.Cells("PageHeight").ResultIU

' put the returned table into the form for a visual check of what came back

trafForm.dlvTraffic.Clear()

trafForm.dlvTraffic.DataSource = objTBL1

intI = 1

' passe the list of network objects

For Each objROW1 In objTBL1.Rows

' select the master

'Determine X, Y location for placement (in circle around hub)

dblRad = (dblDegreeInc * intI) * PI / 180

dblX = CircleRadius * Cos(dblRad) + (dblPageWidth / 2)

dblY = CircleRadius * Sin(dblRad) + (dblPageHeight / 2)

'Add shape to drawing in proper location

' since we are putting the same object on different layers to

' reflect the traffic pattern, go repull the data from sql server

strSQL = "SELECT * From tblVisioObjects Where visObjName = N'" &
objROW1.Item("visObjName").ToString & "'"

objDA = New OleDb.OleDbDataAdapter(strSQL, strCNN)

objCB = New OleDb.OleDbCommandBuilder(objDA)

objTBL2 = New Data.DataTable

objDA.Fill(objTBL2)

trafForm.dlvTraffic.Clear()

trafForm.dlvTraffic.DataSource = objTBL2



If objTBL2.Rows.Count > 0 Then

For Each objROW2 In objTBL2.Rows

strSearch = objROW2.Item("visObjType").ToString

mstObj = stnObj1.Masters(strSearch)

shpObjNode2 = visApp.ActivePage.Drop(mstObj, dblX, dblY)

'Set shape text

strNodeName = objROW1.Item("visObjName").ToString

shpObjNode2.Name = strNodeName

'put it on the correct layer

strNodeLayer = objROW2.Item("visObjLayer").ToString

blnPreserveMembers = True

' add to the new layer

vsoLayer = vsoLayers.Item(strNodeLayer)

vsoLayer.Add(shpObjNode2, blnPreserveMembers)

' every one is added to the error layer just in case

vsoLayer = vsoLayers.Item("Error")

vsoLayer.Add(shpObjNode2, blnPreserveMembers)

' do something with the character size

vsoCell = shpObjNode2.CellsSRC(visSectionCharacter, visRowCharacter,
visCharacterSize)

vsoCell.FormulaU = StringToFormulaForString("=(height / 1.5in) * 8pt")

vsoCell = shpObjNode2.CellsSRC(visSectionObject, visRowText,
visTxtBlkVerticalAlign)

vsoCell.FormulaU = visVertBottom

shpObjNode2.Text = strNodeName

dblObjSize = 2 / objTBL1.Rows.Count

' remove from the network layer has to wrapped so

' we don't exit if no network layer has been created

Try

vsoLayer = vsoLayers.Item("Network")

vsoLayer.Remove(shpObjNode2, blnPreserveMembers)

Catch

End Try

' call the resize object routine

intRetVal = ResizeShape(shpObjNode2, dblObjSize, dblObjSize)

DoEvents()

Next objROW2

Else

subLogMessage("no select results for " &
objROW1.Item("visObjectName").ToString)

End If

intI = intI + 1

Next objROW1

objTBL1.Dispose()

objTBL1 = Nothing

objTBL2.Dispose()

objTBL2 = Nothing

objCB.Dispose()

objCB = Nothing

objDA.Dispose()

objDA = Nothing



Catch err As Exception

subLogMessage(strSQL & vbCrLf & strSearch & " / " & strNodeLayer)

subLogException(err)

subDisplayException(Nothing, err)

End Try



End Sub