Excel VBA to update a Visio network diagram template - excel

Question

I am in the process of creating diagrams for multiple sites in our enterprise as part of an effort to implement a new technology. I have been gathering the information In an Excel document and from this document I have been able to update various Word documents and Excel documents using VBA, a picture of portion of my spreadsheet along with a sample of the Visio template and desired end state can be found below.
After searching through multiple websites, I was able to come up with the following code that will open the Visio Template, but I can't seem to get it to update the values as expected. As far as I can tell, I seem to be going through the various shapes, as I mentioned, the values are not updating as expected.
Thanks in advance for your help and advice.
Sub UpdateVisioTemplate()
Dim vDocs As Visio.Documents 'Documents collection of instance.
Dim vsoDoc As Visio.Document 'Document to work in
Dim vsoPage As Visio.Page 'Page to work in.
Dim vsoPages As Visio.Pages 'Pages collection of document.
Dim vApp As Visio.Application 'Declare an Instance of Visio.
Dim vsoShape As Visio.Shape 'Instance of master on page.
Dim vsoCharacters As Visio.Characters
Dim DiagramServices As Integer
Dim VarRow As Long
Dim FileName, DocName, VarName, VarValue, SiteID, SiteType, Wave, SiteName As String
'Dim vContent As Word.Range
With ActiveSheet
DocName = .Cells(1, 6).Value
SiteType = .Cells(1, 25).Value
SiteID = .Cells(20, 5).Value
SiteName = .Cells(21, 5).Value
On Error Resume Next 'Check if Visio is already running
'Set vApp = CreateObject("Visio.Application")
Set vApp = GetObject(, "Visio.Application")
If Err.Number <> 0 Then 'not equal to 0
Err.Clear
Set vApp = CreateObject("Visio.Application")
End If
vApp.Visible = True
Set vDocs = vApp.Documents.OpenEx(DocName, &H1)
'(DocName)
'Set vDocs = vApp.Documents.Open(DocName)
Set vsoPages = vApp.ActiveDocument.Pages
DiagramServices = vApp.ActiveDocument.DiagramServicesEnabled
vApp.ActiveDocument.DiagramServicesEnabled = visServiceVersion140
LastRow = .Range("A999").End(xlUp).Row
For Each vsoPage In vsoPages
For VarRow = 2 To LastRow 'from Row 2 to the last row
For Each vsoShape In vsoPage.Shapes
VarName = .Cells(VarRow, 1).Value 'VariableName
VarValue = .Cells(VarRow, 2).Value 'VariableValue
If Len(VarValue) = 0 Then 'If the variable value is blank, keep the variable in place
VarValue = .Cells(VarRow, 1).Value
End If
Set vsoCharacters = vsoShape.Charaters
vsoCharacters.Text = Replace(vsoCharacters.Text, VarName, VarValue) 'Find and replace the variables with the appropriate value
Next vsoShape
Next VarRow
Next vsoPage
End With 'Active Sheet
vDoc.SaveAs (SiteID & ".vsd")
End Sub
Sample of Excel Data
Visio Diagram Template
Visio Diagram Final

Answer 1

One thing I noticed was on the line Set vsoCharacters = vsoShape.Charaters - the latter should be vsoShape.Characters instead of Charaters - since this was essentially set to blank (nothing), then there was nothing to 'replace' and nothing changed.
The reason this did not appear is because the 'on error resume next' statement was made earlier which suppresses error messages and simply continues.