Adding Shape File With Access VBA

DavidDuncan

Good Morning,
Here's my scenario: I have an access database, an arcMap (.mxd) file, and a shape file. What I would like is for the user to be able to click a button on an access form and have a certain shape file added to the ArcMap file (which is acting as a template). I would then modify the definition query of the shapefile to reflect information taken from the database.
I've been able to open the arcMap file, and add the shape file, but that's when things get weird. The loading animation doesn't stop spinning, and the map display area stops refreshing (it just displays whatever was on the screen last). While the shape file can be found in the "layers" box, you have to "flip" back and forth between different tabs to make it appear (once again, a screen refresh problem).
Is what I'm trying to do possible? I'm willing to write this within arcMap if I have to, but I think it would be easier, for the users, to keep all functionality contained in the database.

Program Info: Access 2003
[INDENT] [INDENT][INDENT][INDENT][INDENT][INDENT][INDENT] ArcMap 9.3[/INDENT][/INDENT][/INDENT][/INDENT][/INDENT][/INDENT][/INDENT]
Here is the VBA code from my database:

Option Compare Database 
Option Explicit 

Private arcMapApp As esriArcMap.Application 

Public Sub setUpMap()
'Opens ArcMap, adds the shapefiles, and then modifies their representation
On Error GoTo errorHandler 

[INDENT] Dim productKeyCheck As IAoInitialize 
  
Set productKeyCheck = New AoInitialize 
  
'We check to make sure that no other instances are running with this key
If productKeyCheck.IsProductCodeAvailable(esriLicenseProductCodeArcView) Then 
   'Initialize ArcView
[INDENT] productKeyCheck.Initialize esriLicenseProductCodeArcView 
openMapTemplate 
addShapeFiles[/INDENT] 
Else 
[INDENT] MsgBox "Product Code Unavailable For Use", vbExclamation, _ 
"Product Code Unavailable"[/INDENT] 
End If 

productKeyCheck.Shutdown 

Set productKeyCheck = Nothing[/INDENT] 
Exit Sub 
errorHandler: 
MsgBox Err.Description, vbExclamation, "Error in setUpMap" 
End Sub

Private Sub openMapTemplate()
'Opens ArcMap and sets the global variables
On Error GoTo errorHandler 
  
[INDENT] Dim arcMapDocument As MxDocument 
  
Set arcMapDocument = New MxDocument 
Set arcMapApp = arcMapDocument.Parent 
  
arcMapApp.OpenDocument CurrentProject.Path & "\Distribution_Plot_Template.mxd" 
  
Set arcMapDocument = Nothing 
[/INDENT]Exit Sub 

errorHandler: 
MsgBox Err.Description, vbExclamation, "Error in openMapTemplate" 
End Sub

Private Sub addShapeFiles()
'Adds the shapefiles to the map template
On Error GoTo errorHandler 

[INDENT] Dim pMap As IMap 
Dim pFeatureLayer As IFeatureLayer 
Dim pFeatureWorkspace As IFeatureWorkspace 
Dim pMxDocument As IMxDocument 
Dim pWorkSpaceFactory As IWorkspaceFactory 
  
Set pWorkSpaceFactory = New ShapefileWorkspaceFactory 
  
Set pFeatureWorkspace = pWorkSpaceFactory.OpenFromFile(CurrentProject.Path & _ 
"\Claim_Shapefile\", arcMapApp.Hwnd) 
  
   'Set up the feature Layer
Set pFeatureLayer = New featureLayer 
Set pFeatureLayer.FeatureClass = pFeatureWorkspace.OpenFeatureClass("Goldstone_Brookbank_Claims_605") 
pFeatureLayer.Name = pFeatureLayer.FeatureClass.AliasName 
pFeatureLayer.Visible = True 
  
   'Get the document
Set pMxDocument = arcMapApp.Document 
  
   'Initialize the map and add the shape file to it
Set pMap = pMxDocument.FocusMap 
pMap.AddLayer pFeatureLayer 
  
Set pMap = Nothing 
Set pMxDocument = Nothing 
Set pFeatureLayer = Nothing 
Set pFeatureWorkspace = Nothing 
Set pWorkSpaceFactory = Nothing[/INDENT]  
Exit Sub 
errorHandler: 
Set pMap = Nothing 
Set pMxDocument = Nothing 
Set pFeatureLayer = Nothing 
Set pFeatureWorkspace = Nothing 
Set pWorkSpaceFactory = Nothing 
MsgBox Err.Description, vbExclamation, "Error in addShapeFiles" 
End Sub

Here are some screenshots from ArcMap:

When it first opens:


After clicking on the source tab in the layers view (note that I had navigated between windows before taking this screenshot, hence the code image in the non-refreshing map area).


Moving back to the "display" tab

DavidDuncan

Found a solution!

If you save the map while it's stuck in the "spinning globe" phase, close the program, and then open the newly saved file, the shape information appears just fine.

To achieve this in the code, I first modified "openMapTemplate()" into a more generic "openMap()" subroutine

Private Sub openMap(filename As String)
'Opens the given file in ArcMap
[INDENT] Dim arcMapDocument As MxDocument 
  
Set arcMapDocument = New MxDocument 
Set arcMapApp = arcMapDocument.Parent 
  
arcMapApp.OpenDocument filename 
  
Set arcMapDocument = Nothing[/INDENT]  End Sub

And then changed the end of "addShapeFiles()" to this:

   'Initialize the map and add the shape file to it [INDENT]Set pMap = pMxDocument.FocusMap 
pMap.AddLayer pFeatureLayer 
  
arcMapApp.SaveAsDocument CurrentProject.Path & "\MapCopy.mxd" 
arcMapApp.Shutdown 
  
openMap CurrentProject.Path & "\MapCopy.mxd"[/INDENT]

It's not the most elegant of solutions, but it'll get the job done.