Redirect Multiple Batch Lyr Layerfiles in ArcCatalog

[RW]

Hi

We have hundreds of folders and inside the folders there is 1 mxd and approx 6 shapefiles and 6 layerfiles.  Unfortunately the layerfiles have been created from a geodatabase and so are 'looking' at the wrong data source - so do not work.

We have some code that basically works by selecting an mxd in catalog - it runs through the toc and saves out the layer files to a selected folder (in essence replacing or overwriting any existing lyrs).  The process works to a point - the layerfiles are created but when you click on preview they need redirected! Any ideas how to fix this or any other ways we should go about batch redirection?  (We want to avoid having to open every mxd if possible) Frm Code is below:

VERSION 5.00
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} CreateLayerFiles
   Caption         =   "Create Layer Files from selected MXDs"
   ClientHeight    =   1020
   ClientLeft      =   45
   ClientTop       =   435
   ClientWidth     =   5340
   OleObjectBlob   =   "CreateLayerFiles.frx":0000
   StartUpPosition =   1  'CenterOwner
End
Attribute VB_Name = "CreateLayerFiles"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False

Option Explicit
Private Declare Function GetDesktopWindow Lib "user32" () As Long

Private Sub Browse_Click()
  Me.outputDir = GetPathFromDialog("Folder for output layer files")
End Sub

Private Sub Cancel_Click()
  Unload Me
End Sub

Private Sub Ok_Click()
  Dim outDir As String
  outDir = Me.outputDir
  '
  ' Get filesystem object
  '
  Dim pFSO As Scripting.fileSystemObject
  Set pFSO = New Scripting.fileSystemObject
  '
  ' Check folder exists
  '
  If (Not pFSO.FolderExists(outDir)) Then
    pFSO.CreateFolder (outDir)
  End If
 
  Call DoMXDs(outDir)
 
  Unload Me
End Sub

Sub DoMXDs(outDir As String)
  '
  ' Get application
  '
  Dim pGxApp As IGxApplication
  Set pGxApp = Application
  '
  ' Get list of selected objects
  '
  Dim pEnumGxObj As IEnumGxObject
  Set pEnumGxObj = pGxApp.Catalog.Selection.SelectedObjects
  If (pGxApp.Catalog.Selection.Count = 0) Then Exit Sub
  '
  ' Loop through each selected mxd (ignore an other selected objects)
  '
  Dim pGxObject As IGxObject
  Set pGxObject = pEnumGxObj.Next
  Do Until pGxObject Is Nothing
    If (TypeOf pGxObject Is IGxMap) Then
      Call CreateLyr(pGxObject.FullName, outDir)
      Application.StatusBar.Message(0) = "Finished modifying " & pGxObject.FullName
    End If
   
    Set pGxObject = pEnumGxObj.Next
  Loop
   
End Sub

Sub CreateLyr(mxdPath As String, outDir As String)
  Dim pMapDocument As IMapDocument
  Set pMapDocument = New MapDocument
  pMapDocument.Open mxdPath
  Dim pActiveView As IActiveView
  Set pActiveView = pMapDocument.PageLayout
  'pActiveView.Activate GetDesktopWindow()
  pActiveView.Activate Application.hWnd
  '
  ' Loop through each map in mxd
  '
  Dim i As Long, pMap As IMap
  For i = 0 To pMapDocument.MapCount - 1
    Set pMap = pMapDocument.Map(i)
    '
    ' Loop through each layer and save to lyr file
    '
    Dim pLayers As IEnumLayer
    Set pLayers = pMap.Layers(Nothing, True)
    Dim pLayer As ILayer
    Set pLayer = pLayers.Next
    Do Until pLayer Is Nothing
      Call StoreRelativeBase(pLayer, outDir)
      Set pLayer = pLayers.Next
    Loop
  Next i
 
End Sub

Function GetPathFromDialog(theTitle As String) As String
  '
  ' Name: GetPathFromDialog
  ' Purpose: To Get workspace path from user via a dialog
  ' Written: K.Adlam
  '
  Dim pGxDialog As IGxDialog
  Set pGxDialog = New GxDialog
  pGxDialog.AllowMultiSelect = False
  pGxDialog.Title = theTitle
  'pGxDialog.StartingLocation = "Database Connections"
  '
  'Set up filter to restrict data type shown to layers
  '
  Dim pGxFilter As IGxObjectFilter
  'Set pGxFilter = New GxFilterLayers
  Set pGxFilter = New GxFilterContainers
  Set pGxDialog.ObjectFilter = pGxFilter
  '
  ' Open Dialog
  '
  Dim pEnumGxObj As IEnumGxObject
  If Not pGxDialog.DoModalOpen(0, pEnumGxObj) Then
  'If Not pGxDialog.DoModalSave(0) Then
  GetPathFromDialog = ""
    Exit Function
  End If
  '
  ' Loop through selected objects and add to current map
  '
  Dim pGxObj As IGxObject
  pEnumGxObj.Reset
  Set pGxObj = pEnumGxObj.Next
  GetPathFromDialog = pGxObj.FullName

End Function

Public Sub StoreRelativeBase(inLayer As ILayer, inRelBase As String)
  If (TypeOf inLayer Is IDataLayer2) Then
    Dim pDataLayer As IDataLayer2
    Set pDataLayer = inLayer
    pDataLayer.RelativeBase = inRelBase
    Dim pGxLayer As IGxLayer
    Dim pGxFile As IGxFile
   
    Set pGxLayer = New GxLayer
    Set pGxFile = pGxLayer
    pGxFile.path = inRelBase & "\" & inLayer.Name & ".lyr"
    Set pGxLayer.Layer = inLayer
  End If
End Sub

Private Sub UserForm_Click()

End Sub