Visio Save Options warning message

Joined
Jan 3, 2012
Messages
1
Reaction score
0
Hi all,
********* URGENT ASSISTANCE NEEDED *********

It's been a long long time that I have been struggling to get rid of the save options message window while saving shape's fill in VB6 code.
Actually I am getting the Save Options Window whne trying to save the older versions of Visio files in Visio 2003.
Please see the code below:

Sub StencilFill()

Dim mstObj As Visio.Master, mstObjCopy As Visio.Master
Dim StnObj As Visio.Document
Dim appVisio As Visio.Application
Dim shpsObj As Visio.Shapes, shpObj As Visio.Shape
Dim PathFileName As String, PathName As String, CurrFileName As String
Dim curPageIndx As Integer, curShapeIndx As Integer ' Loop variable
Dim lRet As Long

On Error GoTo ErrBlock

' Set the default pathname
PathName = txtBrowse.Text & "\" '"C:\VisioTemp\"
PathFileName = PathName & "*.vsd"

' Find the first file from the directory (not necessarily the first alphabetically)
CurrFileName = Dir(PathFileName)

' Find the first file from the directory (not necessarily the first alphabetically)
CurrFileName = Dir(PathFileName)

'Set appVisio = CreateObject("visio.application")
Set appVisio = New Visio.Application

Do While CurrFileName <> ""

' Open the file
PathFileName = PathName & CurrFileName
Set StnObj = appVisio.Documents.Open(PathFileName)

For curShapeIndx = 1 To StnObj.Masters.Count
Set mstObj = StnObj.Masters(curShapeIndx)
Set mstObjCopy = mstObj.Open
Set shpsObj = mstObjCopy.Shapes
Set shpObj = shpsObj(1)

If InStr(mstObj.Name, "Joint") = 0 Then

' Find the top shape
ShapesCnt = shpsObj.Count

Dim vsdShape As Visio.Shape
Dim i1, j As Integer
For i1 = 1 To ShapesCnt

Set vsdShape = shpsObj.Item(i1)

If vsdShape.Shapes.Count > 0 Then

' Loop through all the shapes on the page to find their locations
For j = 1 To vsdShape.Shapes.Count
vsdShape.Shapes(j).Cells("FillPattern") = 0
Next j
Else
vsdShape.Cells("FillPattern") = 0
End If
Next i1
End If
mstObjCopy.Close
Next curShapeIndx

StnObj.Application.AlertResponse = 6
StnObj.Save
StnObj.Close
Set StnObj = Nothing
CurrFileName = Dir
Loop

appVisio.Quit

ErrBlock:
MsgBox Err.Description
MsgBox "The following error occured: " & vbNewLine & "Error # " & Err.Number & vbNewLine & Err.Description, vbCritical, "Open Error"

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