stencil file save error!!

Y

YOUNGHEE

I can change Master's custom property buy using Master.Open method.
But When I open document next time, Master's change is not saved.
So I add doc.save method. But it raised error.
I see the below message in the help file.

Message : Until a document has been saved, the Save method generates an
error.

How can I save Stencil file?
Please Help me.....


Private Sub ProcessCustomPropertySet()
Dim docsObj As Visio.Documents
Dim docObj As Visio.Document
Dim mstObj As Visio.Master
Dim mstObjCopy As Visio.Master
Dim shpObj As Visio.Shape
Dim cellObj As Visio.Cell

' On Error Resume Next

If (MsgBox("All of Master's Custom Property will be changed. " + vbCr +
Do you continue?", vbCritical + vbOKCancel, _
"Apply Custom Property Set") = vbOK) Then
Dim con As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim rsProperty As New ADODB.Recordset
Dim strConn As String
Dim i As Integer
Dim rownum As Integer

strConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data
Source=C:\visio\VisioDBHandle\visio_automation.mdb;Persist Security
Info=False"

con.ConnectionString = strConn
con.Open

Set docsObj = vsoapp.Documents

For Each docObj In docsObj
If InStr(1, UCase(docObj.Name), ".VSS", vbTextCompare) > 0 Then
rs.Open "SELECT CTABLE_NAME FROM STENCIL WHERE STENCIL_NAME
= '" + docObj.Name + "'", con

If Not rs.EOF Then
rsProperty.Open "SELECT * FROM " + rs(0), con
For Each mstObj In docObj.Masters
Set mstObjCopy = mstObj.Open
Set shpObj = mstObjCopy.Shapes(1)

shpObj.DeleteSection visSectionProp

rsProperty.MoveFirst
While Not rsProperty.EOF
shpObj.AddSection visSectionProp
rownum = shpObj.AddRow(visSectionProp,
visRowLast, 0)

Set cellObj = shpObj.CellsSRC(visSectionProp,
rownum, visCustPropsValue)
cellObj.Formula =
IIf(IsNull(rsProperty.Fields("Value")), """""", """" +
rsProperty.Fields("Value") + """")

Set cellObj = shpObj.CellsSRC(visSectionProp,
rownum, visCustPropsPrompt)
cellObj.Formula =
IIf(IsNull(rsProperty.Fields("Prompt")), """""", """" +
rsProperty.Fields("Prompt") + """")

Set cellObj = shpObj.CellsSRC(visSectionProp,
rownum, visCustPropsLabel)
cellObj.Formula =
IIf(IsNull(rsProperty.Fields("Label")), """""", """" +
rsProperty.Fields("Label") + """")

Set cellObj = shpObj.CellsSRC(visSectionProp,
rownum, visCustPropsFormat)
cellObj.Formula =
IIf(IsNull(rsProperty.Fields("Format")), """""", """" +
rsProperty.Fields("Format") + """")

Set cellObj = shpObj.CellsSRC(visSectionProp,
rownum, visCustPropsSortKey)
cellObj.Formula =
IIf(IsNull(rsProperty.Fields("Sortkey")), """""", """" +
rsProperty.Fields("Sortkey") + """")

Set cellObj = shpObj.CellsSRC(visSectionProp,
rownum, visCustPropsType)
cellObj.ResultIU =
IIf(IsNull(rsProperty.Fields("Type")), 0, rsProperty.Fields("Type"))

Set cellObj = shpObj.CellsSRC(visSectionProp,
rownum, visCustPropsInvis)
cellObj.ResultIU =
IIf(IsNull(rsProperty.Fields("Invisible")), 0,
rsProperty.Fields("Invisible"))

Set cellObj = shpObj.CellsSRC(visSectionProp,
rownum, visCustPropsAsk)
cellObj.ResultIU =
IIf(IsNull(rsProperty.Fields("Ask")), 0, rsProperty.Fields("Ask"))

rsProperty.MoveNext
Wend

mstObjCopy.Close
Next
rsProperty.Close
End If

rs.Close

'docObj.Save

End If
Next
End If

Exit Sub

errHandler:
MsgBox Err.Description
End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top