Add a WMS service to a map using VBA

Summary

Instructions provided describe how to programmatically add web map service (WMS) layers to a map using VBA code.

The script below requires a DCOM connection, which was deprecated from ArcGIS at version 10.1. Refer to the following page on Github for a similar solution using ArcObjects.

Procedure

1. Start ArcMap.
2. Open the VBA Editor.
3. Add a reference to the ESRI GIS Client Object Library.
4. Paste the following code in the VBA editor:

   Private Sub AddWMSLayer()
           Dim wmsMapLayer As IWMSGroupLayer
           Set wmsMapLayer = New wmsMapLayer
           Dim connName As IWMSConnectionName
           Set connName = New WMSConnectionName
           Dim propSet As IPropertySet
           Set propSet = New PropertySet
           propSet.SetProperty "URL", "http://gisdata.usgs.net/servlet/com.esri.wms.Esrimap?"
           connName.ConnectionProperties = propSet
           '' uses the name information to connect to the service
           Dim dataLayer As IDataLayer
           Set dataLayer = wmsMapLayer
           dataLayer.Connect connName
           '' get service description out of the layer
           Dim serviceDesc As IWMSServiceDescription
           Set serviceDesc = wmsMapLayer.WMSServiceDescription
           Dim i As Long
           For i = 0 To serviceDesc.LayerDescriptionCount - 1
               Dim layerDesc As IWMSLayerDescription
               Set layerDesc = serviceDesc.LayerDescription(i)
               Dim newLayer As ILayer
               If (layerDesc.LayerDescriptionCount = 0) Then
                   Dim newWMSLayer As IWMSLayer
                   Set newWMSLayer = wmsMapLayer.CreateWMSLayer(layerDesc)
                   Set newLayer = newWMSLayer
               Else
                   Dim grpLayer As IWMSGroupLayer
                   Set grpLayer = wmsMapLayer.CreateWMSGroupLayers(layerDesc)
                   Set newLayer = grpLayer
               End If
               wmsMapLayer.InsertLayer newLayer, 0
           Next
           Dim layer As ILayer
           Set layer = wmsMapLayer
           layer.Name = serviceDesc.WMSTitle
           Dim mxDoc As IMxDocument
           Set mxDoc = Document
           mxDoc.FocusMap.AddLayer wmsMapLayer
           'refresh
           Dim activeView As IActiveView
           Set activeView = mxDoc.FocusMap
           activeView.Refresh
       End Sub

5. Replace the propSet.SetProperty URL, with the desired WMS service URL, currently:

   http://gisdata.usgs.net/servlet/com.esri.wms.Esrimap?

6. Compile and run the script.