Get Geography Network FREE Services


Connects and retrieves all FREE services from the Geography Network ArcIMS Server.Each FREE service name and type will be print out in the VB or VBA's Immediate Windowavailable from View menu or Crtl+G.

How to use:
  1. On the Tools menu go to the Macros and select Visual Basic Editor or use Alt+F11.
  2. From the Project Explorer dialog (Ctrl+R), and double click on ThisDocument from the Project project.
  3. Bring the Immediate Window, available from your VB/VBA Editor from View menu (Crtl+G), copy/pase this code and run.
Private Sub GetArcIMSServices()
On Error Resume Next
    Dim pIMSConnection As esriCore.IIMSConnection
    Dim pGxObjectContainer As esriCore.IGxObjectContainer
    Dim pEnumGxObject As esriCore.IEnumGxObject
    Dim pIMSServiceDescription As esriCore.IIMSServiceDescription
    Dim i As Integer
    i = 1
    ' ... Cocreate an instance of the IMSConnection object
    Set pIMSConnection = New esriCore.IMSConnection
    With pIMSConnection
        ' .... assign the ArcIMS URL Server
        .URL = ""
        ' ... Connects to the server
        ' ... Verify that the connection has succeded
        If Not .IsConnected Then Exit Sub
        Debug.Print "Server: " & .URL
        Debug.Print "Services:"
    End With
    ' ... Pass the connection to a GX container to get the children
    Set pGxObjectContainer = pIMSConnection
    ' ... Get an enumeration of the ArcIMS Map Services in the container
    Set pEnumGxObject = pGxObjectContainer.Children
    ' ... Get the first child, in this case is the first ArcIMS Service
    Set pIMSServiceDescription = pEnumGxObject.Next
    ' ... Loop throught each service (child) in the container, and print some service information
    Do While Not pIMSServiceDescription Is Nothing
        Debug.Print i & ". " & pIMSServiceDescription.Name & " (" & IIf(pIMSServiceDescription.ServiceType = 0, "Image Service", "Feature Service") & ")"
        Set pIMSServiceDescription = pEnumGxObject.Next
        i = i + 1
    Set pIMSConnection = Nothing
End Sub