Attribute VB_Name = "Access_connect"
Sub Open_Access_Connect()
  'V. Guissard Jan. 2007

  On Error GoTo EH

  Dim data_source As String
  Dim pTable As ITable
  Dim TableName As String
  
  Dim pFeatWorkspace As IFeatureWorkspace
  Dim pMap As IMap
  Dim mxDoc As IMxDocument
  Dim pPropset As IPropertySet
  Dim pStTab As IStandaloneTable
  Dim pStTabColl As IStandaloneTableCollection
  Dim pWorkspace As IWorkspace
  Dim pWorkspaceFact As IWorkspaceFactory
  
  
  Set pPropset = New PropertySet
  ' Get MDB file name
  data_source = GetFolder("mdb")
  ' Connect to the MDB database
  pPropset.SetProperty "CONNECTSTRING", "Provider=Microsoft.Jet.OLEDB.4.0;" _
  & "Data source=" & data_source & ";User ID=Admin;Password="
 
  Set pWorkspaceFact = New OLEDBWorkspaceFactory
  Set pWorkspace = pWorkspaceFact.Open(pPropset, 0)
  Set pFeatWorkspace = pWorkspace
  
  ' Get table name
  TableName = SelectDataSet(pFeatWorkspace, "Table")
  ' Open the table
  Set pTable = pFeatWorkspace.OpenTable(TableName)
  'Create Table collection and add the table to ArcMap
  Set mxDoc = ThisDocument
  Set pMap = mxDoc.FocusMap
  Set pStTab = New StandaloneTable
  Set pStTab.Table = pTable
  Set pStTabColl = pMap
  pStTabColl.AddStandaloneTable pStTab
  
  ' Update ArcMap Source TOC
  mxDoc.UpdateContents
   
  Exit Sub
  
EH:
  
  MsgBox "Access connect: " & Err.Number & " " & Err.Description

End Sub

Public Function GetFolder(Optional aFilter As String) As String
  ' Open a GUI to let the user select a Folder path name (by default) or :
  ' Set aFilter = "shp" to get a shapefile name
  ' Set aFilter = "mdb" to get an MS Access file name
  ' Return the Folder Path or phath & file name As String
  ' V. Guissard Jan. 2007
  
  Dim pGxDialog As IGxDialog
  Dim pFilterCol As IGxObjectFilterCollection
  Dim pCurrentFilter As IGxObjectFilter
  Dim pEnumGx As IEnumGxObject
  
  Select Case aFilter
    Case "shp"
      Set pCurrentFilter = New GxFilterShapefiles
      aTitle = "Select Shapefile"
    Case "mdb"
      Set pCurrentFilter = New GxFilterContainers
      aTitle = "Select MS Access database"
    Case Else
      Set pCurrentFilter = New GxFilterBasicTypes
      aTitle = "Select Folder"
  End Select
  
  Set pGxDialog = New GxDialog
  Set pFilterCol = pGxDialog
  With pFilterCol
    .AddFilter pCurrentFilter, True
  End With
  With pGxDialog
    .Title = aTitle
    .ButtonCaption = "Select"
  End With
  
  If Not pGxDialog.DoModalOpen(0, pEnumGx) Then
    Smp = MsgBox("No selection : Exit", vbCritical)
    End
    'Exit Function 'Exit if user press Cancel
  End If
  GetFolder = pEnumGx.Next.FullName
  
End Function

Public Function SelectDataSet(pWorkspace As IWorkspace, Optional theDataType As String) As String
  ' Open a GUI to let the user select a DataSet into a Workspace
  ' (Table or Request into an MS Access Database or a Geodatabase File)
  ' Set pWorkspace to the DataSet IWorkspace
  ' Set theDataType = "Table" to select a Table name of the DataSet
  ' Return the selected Table or Request Table name As String
  ' V. Guissard Jan. 2007
    
  Dim aDataset As Boolean
  Dim boolOK As Boolean
  Dim DataSetList As New Collection
  Dim datasetType As Integer
  Dim n As Integer
  
  Dim pDataSetName As IDatasetName
  Dim pListDlg As IListDialog
  Dim pEnumDatasetName As IEnumDatasetName
  
  ' Set the Dataset Type
  Select Case theDataType
    Case "Table"
      datasetType = 10
    Case Else
      Answ = MsgBox("Need a Dataset Type : Exit", vbCritical, "SelectDataset")
      End
  End Select
  
  ' Get the Dataset Names included in the workspace
  Set pEnumDatasetName = pWorkspace.DatasetNames(datasetType)
  
  ' Create the Dataset Names List Dialog
  aDataset = False
  Set pListDlg = New ListDialog
  pEnumDatasetName.Reset
  Set pDataSetName = pEnumDatasetName.Next
  Do While Not pDataSetName Is Nothing
        
       pListDlg.AddString pDataSetName.name
       DataSetList.Add (pDataSetName.name)
        Set pDataSetName = pEnumDatasetName.Next
        aDataset = True
  Loop
  
  ' Open a GUI for the user to select a dataset
  If aDataset Then
    boolOK = pListDlg.DoModal("Select a " & theDataType, 0, Application.hwnd)
    n = pListDlg.choice
    If (n <> -1) Then
        SelectDataSet = DataSetList(n + 1)
    Else
        Sup = MsgBox("No DataSet selected : EXIT", vbCritical, "SelectDataset")
        End
    End If
  End If
End Function