Sub Transfer_Attributes()
  Dim ET As ETGW_Core
  Dim pMxDoc As IMxDocument
  Dim pMap As IMap
  Dim pTargetLayer As IFeatureLayer
  Dim pTargetFeatureClass As IFeatureClass
  Dim pSourceFeatureLayer As IFeatureLayer
  Dim pSourceFeatureClass As IFeatureClass
  Dim pOutFeatureClass As IFeatureClass
  Dim sOutFileName As String
  Set ET = New ETGW_Core
  Set pMxDoc = ThisDocument
  Set pMap = pMxDoc.FocusMap
  Set pTargetLayer = ET.GetLayer("target")
  If pTargetLayer Is Nothing Then
    Exit Sub
  End If
  Set pTargetFeatureClass = pTargetLayer.FeatureClass
  If pTargetFeatureClass.ShapeType <> esriGeometryPolygon Then
    MsgBox "Incorrect Shape type"
    Exit Sub
  End If
  Set pSourceFeatureLayer = ET.GetLayer("source")
  If pSourceFeatureLayer Is Nothing Then
    MsgBox "Layer could not be found"
    Exit Sub
  End If
  Set pSourceFeatureClass = pSourceFeatureLayer.FeatureClass
  If pSourceFeatureClass.ShapeType <> esriGeometryPolygon Then
    MsgBox "Incorrect Shape type"
    Exit Sub
  End If
  sOutFileName = "c:\00\new_polygons.shp"
  '=======================================================================
  Dim sMessage As String
  Dim transferDic As Object
  Set transferDic = CreateObject("Scripting.Dictionary")
  transferDic.Add "POP1990", "Count"
  transferDic.Add "Rainfall", "Value"
  transferDic.Add "CNTY_NAME", "Type"
  transferDic.Add "STATE_NAME", "Type"
  Set pOutFeatureClass = ET.TransferPolygonAttributes(pTargetFeatureClass, _
                     pSourceFeatureClass, sOutFileName, transferDic, sMessage)
  If pOutFeatureClass Is Nothing Then
    MsgBox sMessage, vbCritical
    Exit Sub
  End If
  '========================================================================
  Set pSourceFeatureLayer = New FeatureLayer
  Set pSourceFeatureLayer.FeatureClass = pOutFeatureClass
  pSourceFeatureLayer.Name = pOutFeatureClass.AliasName
  pMap.AddLayer pSourceFeatureLayer
End Sub