|
(Code Updated 6/2 08:00A) If you have an ArcMap document with layers utilizing feature classes on the Utah SGID 9.2 ArcSDE database server as data sources, at some point you will want to 'repoint' these layers to the new SGID 9.3 ArcSDE database server. This is easy enough to do if you only have a couple of data layers through the Data Source tab on the layer properties window in ArcMap. But what if you have a project with lots of layers using the SGID ArcSDE 9.2 server? Paste the code below into you ArcMap VBA editor's Normal template and it will be available to run in any of you .mxd projects. Running the rePointSGIDLayersTo93Connections will repoint all the feature layers in the active ArcMap project's dataframe to the new 9.3 server with one small caveat. The exception is if you use group layers within group layers (nested), the script only operates on layers that are nested two deep or less. Notes: - The script only works for ArcMap 9.3, runs on the active dataframe only
- All repointed data layers use application connects (not direct connects)
- If your layer name was the same as the 9.2 feature class's name, the script will rename the layer to use the 9.3 layer name
- If you save this code in your normal templatye, you should be able to access it in your other ArcMap projects
Here's how to use the code below: - In ArcMap 9.3, open the Visual Basic Editor
- In the VBA Editor window's project explorer, expand the Normal (Normal.mxt) --> ArcMap Objects. Right click on the ThisDocument folderand select 'View Code'
- In the code window that opens, paste the code from this page (starting at the line 'Public Sub rePointSGIDLayersTo93Connection()').
- Make sure your cursor is sill in the code window (if not click it's whitespace once). Then, click the play button (blue triangle) to run the script and repoint your data layers.
How to Open the VBA Editor (step 1): 
Pasting and Running the Repoint Code (steps 2-4): 
'Code Starts Here, Updated 6/02/09, 8:00 AM Public Sub rePointSGIDLayersTo93Connection()
On Error Resume Next
Dim pMXD As IMxDocument
Dim pMap As IMap
Dim gl As ILayer
Dim fL As IFeatureLayer
Dim cL As ICompositeLayer
Dim cL2 As ICompositeLayer
Dim c As Integer
Dim c2 As Integer
Dim c3 As Integer
Dim fc As IFeatureClass
Dim ds As IDataset
Dim l As ILayer
Dim grpLayerIndexNumber As Integer
Dim changeType As Integer
Dim sde_WF As IWorkspaceFactory
Dim pWS As IFeatureWorkspace
Dim pArchiveWS As IFeatureWorkspace
Dim pPropSet As IPropertySet
Dim pLookupTable As ITable
Dim pFC As IFeatureClass
Dim pDataset As IDataset
Dim fcname As String
Dim newfcname As String
Dim databaseStr As String
Dim databaseConnUserNameStr As String
Dim databaseConnPasswordStr As String
Dim databaseConnPortStr As String
Dim databaseServerStr As String
Dim count As Long
Dim changeCount As Long
'***** SET THESE VALUES ********
databaseStr = "SGID93"
databaseConnUserNameStr = "agrc"
databaseConnPasswordStr = "agrc"
databaseConnPortStr = "5151"
databaseServerStr = "gdb93.agrc.utah.gov"
'*****
'get lookup table
Set pPropSet = New PropertySet
With pPropSet
.SetProperty "Server", databaseServerStr
.SetProperty "Instance", databaseConnPortStr
.SetProperty "user", databaseConnUserNameStr
.SetProperty "database", databaseStr
.SetProperty "password", databaseConnPasswordStr
.SetProperty "version", "sde.default"
End With
Set sde_WF = New SdeWorkspaceFactory
Set pWS = sde_WF.Open(pPropSet, 0)
pPropSet.SetProperty "database", "SGID93_Archive"
Set pArchiveWS = sde_WF.Open(pPropSet, 0)
Set pLookupTable = pWS.OpenTable("SGID93.Indices.TRANSLATEFCNAMES_92_TO_93")
'***** SET THIS PARAMETER
changeType = 2 'change data source to SDE Application Connect
Set pMXD = ThisDocument
Set pMap = pMXD.FocusMap 'work on active dataframe only
For c = 0 To pMap.LayerCount - 1
Debug.Print count & " " & pMap.Layer(c).Name
If TypeOf pMap.Layer(c) Is ICompositeLayer Then
Set cL = pMap.Layer(c)
For c2 = 0 To cL.count - 1
If TypeOf cL.Layer(c2) Is ICompositeLayer Then
Set cL2 = cL.Layer(c2)
For c3 = 0 To cL2.count - 1
count = count + 1
If TypeOf cL2.Layer(c3) Is IFeatureLayer Then
Set fL = cL2.Layer(c3)
Set pFC = fL.FeatureClass
Set pDataset = pFC
fcname = pDataset.Name newfcname = ""
newfcname = do92To93Lookup(pLookupTable, fcname)
If newfcname <> "" Then
If InStr(newfcname, "SGID93_Archive") = 1 Then
Set pFC = changeFeatureClassWorkspace(pArchiveWS, newfcname)
Else
Set pFC = changeFeatureClassWorkspace(pWS, newfcname)
End If
If Not pFC Is Nothing Then
Set fL.FeatureClass = pFC
If fL.Name = fcname Then
fL.Name = newfcname
End If
changeCount = changeCount + 1
End If
End If
End If
Next c3
ElseIf TypeOf cL.Layer(c2) Is IFeatureLayer Then
count = count + 1
Set fL = cL.Layer(c2)
Set pFC = fL.FeatureClass
Set pDataset = pFC
fcname = pDataset.name newfcname = ""
newfcname = do92To93Lookup(pLookupTable, fcname)
If newfcname <> "" Then
If InStr(newfcname, "SGID93_Archive") = 1 Then
Set pFC = changeFeatureClassWorkspace(pArchiveWS, newfcname)
Else
Set pFC = changeFeatureClassWorkspace(pWS, newfcname)
End If
If Not pFC Is Nothing Then
Set fL.FeatureClass = pFC
If fL.Name = fcname Then
fL.Name = newfcname
End If
changeCount = changeCount + 1
End If
End If
End If
Next c2
ElseIf TypeOf pMap.Layer(c) Is IFeatureLayer Then
count = count + 1
Set fL = pMap.Layer(c)
Set pFC = fL.FeatureClass
Set pDataset = pFC
fcname = pDataset.Name newfcname = ""
newfcname = do92To93Lookup(pLookupTable, fcname)
If newfcname <> "" Then
If InStr(newfcname, "SGID93_Archive") = 1 Then
Set pFC = changeFeatureClassWorkspace(pArchiveWS, newfcname)
Else
Set pFC = changeFeatureClassWorkspace(pWS, newfcname)
End If
If Not pFC Is Nothing Then
Set fL.FeatureClass = pFC
If fL.Name = fcname Then
fL.Name = newfcname
End If
changeCount = changeCount + 1
End If
End If
End If
Next c
MsgBox changeCount & " out of " & count & " SGID feature layers (vector) have been" & _
" repointed to 9.3", vbOKOnly, "9.3 Repoint Complete"
End Sub
Public Function changeFeatureClassWorkspace(inWS As IFeatureWorkspace, inFCName As String) As IFeatureClass
'open feature class at new location
Set changeFeatureClassWorkspace = inWS.OpenFeatureClass(inFCName)
End Function
Public Function do92To93Lookup(inLookupTable As ITable, inFCName As String) As String
on error goto ErrorHandler
Dim pCursor As ICursor
Dim pRow As IRow
Dim pQF As IQueryFilter
Dim fcStr() As String
do92To93Lookup = ""
fcStr = Split(inFCName, ".")
Set pQF = New QueryFilter
pQF.WhereClause = "FCNAME92 = '" & fcStr(2) & "' and OWNER92 = '" & fcStr(1) & _
"' and DBNAME92 = '" & fcStr(0) & "'"
Set pCursor = inLookupTable.Search(pQF, False)
Set pRow = pCursor.NextRow
If Not pRow Is Nothing Then
do92To93Lookup = "SGID93." & pRow.Value(pRow.Fields.FindField("OWNER93")) & _
"." & pRow.Value(pRow.Fields.FindField("FCNAME93"))
End If Exit function ErrorHandler:
return
End Function
|
