Free Code

• Automatically change datasources in ArcMap TOC:
  Open VBA Editor and paste the following code in This.Document. -> modify paths -> then Run. Please see our disclaimer.

  // Provided by 39 DEGREES NORTH, LLC
  // www.39dn.com
  
  Sub SetDataSource()
  
     Dim pFWorkspace As IFeatureWorkspace
     Dim pRWorkspace As IRasterWorkspace
     Dim pNewFC As IFeatureClass
     Dim pOldFC As IFeatureClass
     Dim pOldDS As IDataset
     Dim pOldName As IName
     'get the featureworkspace
  
     'uncomment for SDE
     'Set pFWorkspace = OpenSDEWorkspace("serverName", "port#", "database", "username", "password")
  
     'uncomment for Personal or File GeoDatabase
     'Set pFWorkspace = openAccessWorkspace("C:\location\name.mdb")
  
     'Get current FeatureClass of first layer
     Dim pMxdoc As IMxDocument
     Dim pMap As IMap
     Dim pActiveView As IActiveView
     Dim pMapAdmin2 As IMapAdmin2
     Dim pFLayer As IFeatureLayer
     Set pMxdoc = ThisDocument
     Set pMap = pMxdoc.FocusMap
     Set pMapAdmin2 = pMap
     Set pActiveView = pMap
  
  
     Dim pDataLayer As IDataLayer
     Dim pDatasetName As IDatasetName
  
     Dim pFLayers As IEnumLayer
     Set pFLayers = pMap.Layers
  
     pFLayers.Reset
     Dim pLayer As ILayer
     Set pLayer = pFLayers.Next
  
     Do Until pLayer Is Nothing
       Debug.Print pLayer.name
  
       If TypeOf pLayer Is IFeatureLayer Then
  
         Set pFLayer = pLayer
         Set pDataLayer = pFLayer
         Set pDatasetName = pDataLayer.DataSourceName
  
         Debug.Print pDatasetName.name
  
       Set pNewFC = pFWorkspace.OpenFeatureClass(pDatasetName.name)
       'Change FeatureClass of layer
       Set pFLayer.FeatureClass = pNewFC
       pMapAdmin2.FireChangeFeatureClass pOldFC, pNewFC
       End If
  
     Set pLayer = pFLayers.Next
  
     Loop
     pActiveView.Refresh
  
     'Update and Refresh TOC
     pMxdoc.CurrentContentsView.Refresh 0
  End Sub
  
  Public Function OpenSDEWorkspace(server As String, _
         instance As String, _
         databasename As String, _
         username As String, _
         password As String) As IFeatureWorkspace
  
     Dim pWSF As IWorkspaceFactory
     Set pWSF = New SdeWorkspaceFactory
  
     Dim pPropSet As IPropertySet
     Set pPropSet = New PropertySet
     With pPropSet
       .SetProperty "Server", server
       .SetProperty "Instance", instance
       .SetProperty "User", username
       .SetProperty "Password", password
       .SetProperty "Database", databasename
       .SetProperty "Version", "sde.Default"
  
     End With
  
     'pWSF.PrepareConnectionProperties = pPropSet
  
     Dim pWS As IWorkspace
     Set pWS = pWSF.Open(pPropSet, 0)
  
     Set OpenSDEWorkspace = pWS
  End Function
  
  Public Function openAccessWorkspace(fName As String)
       Dim pWSF As IWorkspaceFactory
       Set pWSF = New AccessWorkspaceFactory
  
       Dim pWS As IWorkspace
       Set pWS = pWSF.OpenFromFile(fName, 0)
  
       Set openAccessWorkspace = pWS
  End Function