Sub SaveFirstLayer()
  Dim pMxDoc As IMxDocument
  Set pMxDoc.FocusMap
  SaveLayerDialog pMxDoc.FocusMap.Layer(0), Application.hWnd
End Sub

Public Function SaveLayerDialog(ByRef pLayer As ILayer, Optional lParentWindow As Long = 0, Optional ByRef sLayerPath As String) As IGxLayer

  On Error GoTo SaveLayerDialog_ERR

  Dim pGxBrowser As IGxDialog
  Set pGxBrowser = New GxDialog

  Dim pFilter As IGxObjectFilter
  Set pFilter = New GxFilterLayers

  Set pGxBrowser.ObjectFilter = pFilter
  Dim sLayer As String
  Dim sDir As String
  Dim pGLayer As IGraphicsLayer
  Dim pLayer As ILayer
  Dim pGXFile As IGxFile
  Dim pGXLayer As IGxLayer

  If pGxBrowser.DoModalSave(lParentWindow) Then
    
    sLayer = pGxBrowser.name & ".lyr"
    sDir = pGxBrowser.FinalLocation.FullName
    If Right(sDir, 1) <> "\" Then sDir = sDir & "\"
    
    Set pGXLayer = New GxLayer
    Set pGxLayer.Layer = pLayer
    Set pGXFile = pGXLayer
    
    pGXFile.Path = sDir & sLayer
    pGXFile.Save
    sLayerPath = sDir & sLayer
    Set SaveLayerDialog = pGXLayer
    
  End If

  Exit Function

SaveLayerDialog_ERR:
    Debug.Print "SaveLayerDialog_ERR: " & Err.Description
    Debug.Assert 0

End Function

Sub SaveFirstLayer()
  Dim pMxDoc As IMxDocument
  Set pMxDoc.FocusMap
  SaveLayerDialog pMxDoc.FocusMap.Layer(0), Application.hWnd
End Sub

Set pMxDoc = ThisDocument

 Sub SaveFirstLayer()
  Dim pMxDoc As IMxDocument
  Set pMxDoc = ThisDocument
  SaveLayerDialog pMxDoc.FocusMap.Layer(0), Application.hWnd
End Sub

Public Function SaveLayerDialog(ByRef pLayer As ILayer, Optional lParentWindow As Long = 0, Optional ByRef sLayerPath As String) As IGxLayer

  On Error GoTo SaveLayerDialog_ERR

  Dim pGxBrowser As IGxDialog
  Set pGxBrowser = New GxDialog

  Dim pFilter As IGxObjectFilter
  Set pFilter = New GxFilterLayers

  Set pGxBrowser.ObjectFilter = pFilter
  Dim sLayer As String
  Dim sDir As String
  Dim pGLayer As IGraphicsLayer
  Dim pLayer As ILayer
  Dim pGXFile As IGxFile
  Dim pGXLayer As IGxLayer

  If pGxBrowser.DoModalSave(lParentWindow) Then
    
    sLayer = pGxBrowser.name & ".lyr"
    sDir = pGxBrowser.FinalLocation.FullName
    If Right(sDir, 1) <> "\" Then sDir = sDir & "\"
    
    Set pGXLayer = New GxLayer
    Set pGXLayer.Layer = pLayer
    Set pGXFile = pGXLayer
    
    pGXFile.Path = sDir & sLayer
    pGXFile.Save
    sLayerPath = sDir & sLayer
    Set SaveLayerDialog = pGXLayer
    
  End If

  Exit Function

SaveLayerDialog_ERR:
    Debug.Print "SaveLayerDialog_ERR: " & Err.Description
    Debug.Assert 0

End Function

 

Sub SaveFirstLayer()
  Dim pMxDoc As IMxDocument
  Set pMxDoc = ThisDocument
  SaveLayerDialog pMxDoc.FocusMap.Layer(0), Application.hWnd
End Sub

Public Function SaveLayerDialog(ByRef pLayer As ILayer, Optional lParentWindow As Long = 0, Optional ByRef sLayerPath As String) As IGxLayer

  On Error GoTo SaveLayerDialog_ERR

  Dim pGxBrowser As IGxDialog
  Set pGxBrowser = New GxDialog

  Dim pFilter As IGxObjectFilter
  Set pFilter = New GxFilterLayers

  Set pGxBrowser.ObjectFilter = pFilter
  Dim sLayer As String
  Dim sDir As String
  Dim pGLayer As IGraphicsLayer
  Dim pGXFile As IGxFile
  Dim pGXLayer As IGxLayer

  If pGxBrowser.DoModalSave(lParentWindow) Then
    
    sLayer = pGxBrowser.Name & ".lyr"
    sDir = pGxBrowser.FinalLocation.FullName
    If Right(sDir, 1) <> "\" Then sDir = sDir & "\"
    
    Set pGXLayer = New GxLayer
    Set pGXFile = pGXLayer
    
    pGXFile.Path = sDir & sLayer
    Set pGXLayer.Layer = pLayer
    pGXFile.Save
    sLayerPath = sDir & sLayer
    Set SaveLayerDialog = pGXLayer
    
  End If

  Exit Function

SaveLayerDialog_ERR:
    Debug.Print "SaveLayerDialog_ERR: " & Err.Description
    Debug.Assert 0

End Function

Sub SaveFirstLayerAsShapefile()
  Dim pMxDoc As IMxDocument
  Set pMxDoc = ThisDocument
  Dim pFeatureLayer As IFeatureLayer
  Set pFeatureLayer = pMxDoc.FocusMap.Layer(0)
  SaveShapeFileDialog pFeatureLayer.FeatureClass, Application.hWnd
End Sub

Public Function SaveShapeFileDialog(ByRef pFeatureClass As IFeatureClass, Optional lParentWindow As Long = 0)

  On Error GoTo SaveShapefileDialog_ERR

    Dim pGxBrowser As IGxDialog
    Set pGxBrowser = New GxDialog
    
    Dim pFilter As IGxObjectFilter
    Set pFilter = New GxFilterShapefiles
    
    Set pGxBrowser.ObjectFilter = pFilter
    Dim sShapefile As String
    Dim sDir As String
    Dim pGxObject As IGxObject
    
    If Not pGxBrowser.DoModalSave(lParentWindow) Then Exit Function
    
    sShapefile = pGxBrowser.Name
    sDir = pGxBrowser.FinalLocation.FullName
    If Right(sDir, 1) <> "\" Then sDir = sDir & "\"
    
    Dim pWorkspaceName As IWorkspaceName
    Set pWorkspaceName = New WorkspaceName
    With pWorkspaceName
        .PathName = sDir
        .WorkspaceFactoryProgID = "esriCore.ShapefileWorkspaceFactory.1"
    End With
    
    Dim pOutDatasetName As IDatasetName
    Set pOutDatasetName = New FeatureClassName
    Set pOutDatasetName.WorkspaceName = pWorkspaceName
    pOutDatasetName.Name = sShapefile
    
    Dim pInDataset As IDataset
    Set pInDataset = pFeatureClass
        
    Dim pExportOp As IExportOperation
    Set pExportOp = New ExportOperation
    pExportOp.ExportFeatureClass pInDataset.FullName, _
                                 Nothing, _
                                 Nothing, _
                                 pFeatureClass.Fields.Field(pFeatureClass.Fields.FindField(pFeatureClass.ShapeFieldName)).GeometryDef, _
                                 pOutDatasetName, _
                                 Application.hWnd

  Exit Function

SaveShapefileDialog_ERR:
    Debug.Print "SaveShapefileDialog_ERR: " & Err.Description
    Debug.Assert 0

End Function