Excel VBA to update a Visio network diagram template

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

Some of the variable names in the Excel file aren't exact matches for the names on the Visio shapes. For example, Excel has {RTR-1-LAN-INT1} but Visio has {RTR1-LAN-INT1}. Try fixing whichever names are wrong and see if that helps — barrowc
Thanks for the suggestion. I think I might have taken the picture prior to making sure everything matches. Even for the values that do match, the value isn't being updated. — maleante

Brian Moriarty Brian Moriarty · Accepted Answer · 2020-09-20T17:17:11

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.

Excel VBA to update a Visio network diagram template

1 Answers