Hello All,I have used VBA code to automate the check-out process for ArcPad in ArcMap. There are additional procedures that I have been able to translate to VB.Net, but I cannot figure out how to upgrade the attached code. I have googled until my googler is blue. Apparently, the IArcPadExtension has been eliminated and nothing comparable has been offered in its place. I would like to keep this project in ArcPad, but if I must, I will figure out how to migrate it into ArcGIS for Mobile Devices. I am trying to replace my old vba functionality with an ArcMap Add-In.Thanks for any input,NickPS: I wouldn't rule out my poor coding skills or my lack of focus!Public Sub CopyoutCheckout() 'On Error GoTo ErrorHandler '++ get a reference to the ArcPad extension Dim pArcPadExtension As IArcPadExtension Dim pID As New UID pID = "editorExt.ArcPadExtension" Set pArcPadExtension = Application.FindExtensionByCLSID(pID) '++ ArcPad xfer error vars Dim lErrorNum As Long Dim sErrorDesc As String '++ ArcPad transaction/xfer vars Dim pAPTransaction As IArcPadTransaction Set pAPTransaction = pArcPadExtension 'QI Dim pArcPadXfer As IArcPadDataTransfer '++ flag to know if any layers are exported for ArcPad Dim bExported As Boolean '++ set the output folder Dim sOutputFolder As String If frmSelectHood.chkThru = True Then sOutputFolder = "\\coddat04\VACPic\VL Pictures " _ & Format(Date, "yyyy") & "\Thoroughfare_" & Format(Date, "yyyymmdd") Else sOutputFolder = "\\coddat04\VACPic\VL Pictures " _ & Format(Date, "yyyy") & "\" & frmSelectHood.cboHood.value _ & "_" & Format(Date, "yyyymmdd") 'sOutputFolder = "C:\Temp\testDataForArcPad" End If '++ set edit form size to 1/4 VGA size Dim iFormX As Long, iFormY As Long iFormX = 130 iFormY = 130 pAPTransaction.SetFormSize iFormX, iFormY '++ get an IBasicMap ptr to the focus map Dim pMxDoc As IMxDocument Dim pMap As IMap, pBasicMap As IBasicMap Set pMxDoc = ThisDocument Set pMap = pMxDoc.FocusMap Set pBasicMap = pMap '++ get the current view extent Dim pActiveView As IActiveView Dim pExtentEnv As IEnvelope Set pActiveView = pMap Set pExtentEnv = pActiveView.Extent '++ spatial filter for checkout/copyout extent Dim pSpatialFilter As ISpatialFilter Set pSpatialFilter = New SpatialFilter '++ layer definition query Dim pFtrLayerDef As IFeatureLayerDefinition Dim pQueryFilter As IQueryFilter Set pQueryFilter = New QueryFilter '++ get checkout name Dim sCheckoutName If frmSelectHood.chkThru = True Then sCheckoutName = InputBox("Please type the checkout name for this session.", _ "Checkout Name?", "Thoroughfare_" & Format(Date, "yyyymmdd")) Else sCheckoutName = InputBox("Please type the checkout name for this session.", _ "Checkout Name?", frmSelectHood.cboHood.value _ & "_" & Format(Date, "yyyymmdd")) 'ToDo: add code to stop the rest of the code 'from running if Sub is Exited If ("" = sCheckoutName) Then Exit Sub End If '++ create ArcPad data xfer session Set pArcPadXfer = pAPTransaction.CreateDataTransferSession(True, pBasicMap, sOutputFolder) Dim sCurrOutputName As String '<--(((--- 'sCurrOutputName = frmSelectHood.cboHood.value '++ first, handle all IGeoFeatureLayer layers pID = "{E156D7E5-22AF-11D3-9F99-00C04F6BC78E}" 'IID for IGeoFeatureLayer Dim pEnumLayer As IEnumLayer Set pEnumLayer = pMap.Layers(pID, True) If Not pEnumLayer Is Nothing Then Dim pLayer As ILayer Dim pFtrLayer As IFeatureLayer Dim pFClass As IFeatureClass Dim pDataset As IDataset Dim pSelSet As ISelectionSet pEnumLayer.Reset Set pLayer = pEnumLayer.Next Do While Not pLayer Is Nothing '++ get current display extent Set pFtrLayer = pLayer 'QI With pSpatialFilter Set .Geometry = pExtentEnv .GeometryField = pFtrLayer.FeatureClass.ShapeFieldName .SpatialRel = esriSpatialRelIntersects End With '++ get layer definition query '------------------------------ 'Create the query filter '''' If frmSelectHood.chkThru = True Then '''' Set pQueryFilter = New QueryFilter '''' pQueryFilter.WhereClause = "SType = 'Thoroughfare'" '''' Else '''' Set pQueryFilter = New QueryFilter '''' pQueryFilter.WhereClause = "Neighborhood = '" & frmSelectHood.cboHood.value & "'" '''' End If '----------------------- Set pFtrLayerDef = pFtrLayer 'QI Dim selecteditem As String If frmSelectHood.chkThru = True Then selecteditem = frmSelectHood.chkThru.value pQueryFilter.WhereClause = "SType = 'Thoroughfare'" Else selecteditem = frmSelectHood.cboHood.value pQueryFilter.WhereClause = "Neighborhood = '" & selecteditem & "'" 'pQueryFilter.WhereClause = 'pFtrLayerDef.DefinitionExpression End If '++ get selection set Set pFClass = pFtrLayer.FeatureClass Set pSelSet = pFClass.Select(pSpatialFilter, esriSelectionTypeIDSet, esriSelectionOptionNormal, Nothing) '++ give option to checkout or copyout gdb, copyout all others Set pDataset = pFClass 'QI Select Case pDataset.Category Case "Personal Geodatabase Feature Class", "SDE Feature Class": If MsgBox("Yes to Checkout, No to Copyout.", vbYesNo, pFtrLayer.Name) = vbYes Then pArcPadXfer.CheckoutFeatures pLayer, pQueryFilter, pSelSet, True, False, sCheckoutName, "", sCurrOutputName Else pArcPadXfer.CopyoutFeatures pLayer, pQueryFilter, pSelSet, True, True, "", sCurrOutputName End If Case Else: pArcPadXfer.CopyoutFeatures pLayer, pQueryFilter, pSelSet, True, True, "", sCurrOutputName End Select '++ report success or error Select Case lErrorNum Case 0: MsgBox sCurrOutputName & " created.", vbInformation, pFtrLayer.Name bExported = True Case Else: MsgBox lErrorNum, vbExclamation, pFtrLayer.Name & " not exported" lErrorNum = 0 End Select Set pLayer = pEnumLayer.Next Loop End If '++ next, copyout IRasterLayer layers pID = "{D02371C7-35F7-11D2-B1F2-00C04F8EDEFF}" 'IID for IRasterLayer Set pEnumLayer = pMap.Layers(pID, True) If Not pEnumLayer Is Nothing Then pEnumLayer.Reset Set pLayer = pEnumLayer.Next Do While Not pLayer Is Nothing pArcPadXfer.CopyoutRaster pLayer, pExtentEnv, sCurrOutputName '++ report success or error Select Case lErrorNum Case 0: MsgBox sCurrOutputName & " created.", vbInformation, pLayer.Name bExported = True Case Else: MsgBox sErrorDesc, vbExclamation, pLayer.Name & " not created" lErrorNum = 0 End Select Set pLayer = pEnumLayer.Next Loop End If '++ end the transaction pArcPadXfer.Flush If bExported Then MsgBox "Operation complete.", vbInformation, sCheckoutName Else MsgBox "No layers were exported for ArcPad.", vbExclamation, sCheckoutName End If Exit Sub ErrorHandler: Select Case Err.Number '++ handle ArcPad xfer errors Case -2147221247 To -2147221242: lErrorNum = Err.Number sErrorDesc = Err.Description Resume Next '++ handle E_FAIL; likely cause is use of IMap::Layers when no layers match the IID Case -2147467259: Set pEnumLayer = Nothing Resume Next '++ handle all other errors Case Else: MsgBox Err.Number & vbCrLf & Err.Description, vbCritical, "Error" End Select End Sub
