最近、ArcGIS で Access テーブルをプログラムで取得する方法に関する ArcScripts のスクリプトを見つけましたが、うまく機能します。ただし、これは Access 2003 (.mdb 拡張子) 以前のものです。コードは以下に掲載されています。Access 2007 (.accdb 拡張子) 以降のデータベースを使用するためにコードを変更する方法を知りたいです。
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
ArcScript へのリンクは次のとおりです: http://arcscripts.esri.com/Data/AS14882.bas
PS このコードが VBA で書かれていることは知っていますが、変更されたバージョンが VB.NET であるか他の言語であるかはわかりません。
ありがとう、エイドリアン