以编程方式在 ArcMap 中获取 Access 2007 表(.accdb 扩展名)
我最近从 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 还是其他语言编写的。
谢谢, 阿德里安
I have recently found a script from ArcScripts on how to get an Access table in ArcGIS programmatically and it works well. But this is for Access 2003 (.mdb extension) and earlier. The code is posted below, and I want to know how to modify it for using Access 2007 (.accdb extension) and later databases.
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
Here is the link to the ArcScript: http://arcscripts.esri.com/Data/AS14882.bas
PS I know this code is written in VBA and I don't know if a modified version is in VB.NET or whatever else language.
Thanks,
Adrian
如果你对这篇内容有疑问,欢迎到本站社区发帖提问 参与讨论,获取更多帮助,或者扫码二维码加入 Web 技术交流群。
绑定邮箱获取回复消息
由于您还没有绑定你的真实邮箱,如果其他用户或者作者回复了您的评论,将不能在第一时间通知您!
发布评论
评论(2)
当尝试找出 ArcObjects 的连接属性时,我发现使用 GUI 在 arccatalog 中设置 OleDB 连接很有帮助。一旦测试成功,我就会运行此 VBA 脚本来列出连接属性,然后我可以将其复制并粘贴到我的代码中。
更新:以下是我从 此处,以及来自 此处。我没有使用密码,所以无法测试。
When trying to figure out connection properties for ArcObjects, I find it helpful to set up an OleDB connection in arccatalog using the GUI. Once it tests successfully, I then run this VBA script to list the connection properties, which I can then copy and paste into my code.
Update: Here's some code that I tested successfully after downloading the provider from here, and a test accdb file from here. I wasn't using a password, so couldn't test that.
Access 2007 的连接字符串是
这样
-- http://www.connectionstrings.com/access-2007< /a>
The connection string for Access 2007 is
So
-- http://www.connectionstrings.com/access-2007