【发布时间】：2023-03-26 07:10:01
【问题描述】：
我最近从 ArcScripts 中找到了一个关于如何以编程方式在 ArcGIS 中获取 Access 表的脚本，它运行良好。但这是针对 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 还是其他语言。
谢谢， 阿德里安
【问题讨论】：
标签： ms-access ms-access-2007 arcgis esri arcobjects