VBA is close enough to VB6 that you should be able to work with the VB6
examples . The xml examples show how to save/load xml into the visio
document. The assumption is that if you are asking to play with xml in
visio, you already understand visio and xml coding to start with. There are
plenty of examples of how to manipulate xml on msdn since that is not unique
to Visio.
this is an example of manipulating an xml image of a v2007 datarecordset.
al
'
' we pass in the xml version of the recordset
' the recordid, the columnnid, and the new value for the field
' then return the updated xml image of the recordset
'
Public Function setXmlRecordData _
(ByVal strXmlIn As String, _
ByVal lngRowID As Long, _
ByVal lngColId As Long, _
ByVal strValue As String) _
As String
On Error GoTo ErrHandler
Dim strXmlOut As String
Dim docXmlIn As DOMDocument60
Set docXmlIn = New DOMDocument60
' this is the parent of the record node
Dim ndeRecords As IXMLDOMNode
' this is the record node
Dim ndeFind As IXMLDOMNode
' this is the updated record node
Dim ndeNew As IXMLDOMNode
Dim attrFind As IXMLDOMAttribute
Dim strfind As String
' xml60 / visio complains about this xpath format
' strFind = "/xml/rs:data/z:row/@ndeName"
' so we use something like this one instead
' strFind = "//*/*[@ndeName = '01001-a-1-a-1-3550-2']"
' load the document with the string
strfind = "//*/*/*[@c0 = " & lngRowID & "]"
If docXmlIn.LoadXML(strXmlIn) Then
' find row
Set ndeFind = docXmlIn.SelectSingleNode(strfind)
Set ndeRecords = ndeFind.ParentNode
Set ndeNew = ndeFind
Set attrFind = ndeNew.Attributes.Item(lngColId)
attrFind.Value = strValue
ndeRecords.replaceChild ndeNew, ndeFind
setXmlRecordData = docXmlIn.XML
Set docXmlIn = Nothing
Exit Function
Else
' The document failed to load.
Dim strErrText As String
Dim xPE As MSXML2.IXMLDOMParseError
' Obtain the ParseError object
Set xPE = docXmlIn.parseError
If xPE.ErrorCode <> 0 Then
With xPE
strErrText = "Your XML Document failed to load" & _
"due the following error." & vbCrLf & _
"Error #: " & .ErrorCode & ": " & xPE.reason & _
"Line #: " & .Line & vbCrLf & _
"Line Position: " & .linepos & vbCrLf & _
"Position In File: " & .filepos & vbCrLf & _
"Source Text: " & .srcText & vbCrLf & _
"Document URL: " & .URL
End With
MsgBox strErrText, vbExclamation
End If
End If
Set xPE = Nothing
Set docXmlIn = Nothing
setXmlRecordData = ""
Exit Function
ErrHandler:
MsgBox Err.Description
'return empty string
setXmlRecordData = ""
End Function
