我最近在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还是其他任何语言。
谢谢， 阿德里安
答案 0 :(得分：0)
Access 2007的连接字符串是
Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\myFolder\myAccess2007file.accdb;Persist Security Info=False;
所以
pPropset.SetProperty "CONNECTSTRING", "Provider=Microsoft.ACE.OLEDB.12.0;" _
& "Data source=" & data_source & ";User ID=Admin;Password="
答案 1 :(得分：0)
在尝试找出ArcObjects的连接属性时，我发现使用GUI在arccatalog中设置OleDB连接很有帮助。成功测试后，我运行此VBA脚本列出连接属性，然后我可以将其复制并粘贴到我的代码中。
Sub ListConnProps()
Dim pGxApp As IGxApplication
Set pGxApp = Application
If Not TypeOf pGxApp.SelectedObject Is IGxDatabase Then
Debug.Print "select a geodb first"
Exit Sub
End If
Dim pGXdb As IGxDatabase2
Set pGXdb = pGxApp.SelectedObject
Dim names As Variant, values As Variant
Debug.Print pGXdb.WorkspaceName.WorkspaceFactoryProgID
pGXdb.WorkspaceName.ConnectionProperties.GetAllProperties names, values
Dim l As Long
For l = 0 To UBound(names)
Debug.Print names(l), values(l)
Next l
End Sub
更新：以下是我从here下载提供程序后成功测试的一些代码，以及here的测试accdb文件。我没有使用密码，所以无法测试。
public static void TestOleDB()
{
IWorkspaceFactory wsf = new OLEDBWorkspaceFactoryClass();
IPropertySet ps = new PropertySetClass();
string connStr = "Provider=Microsoft.ACE.OLEDB.12.0;"
+ @"Data Source=D:\Projects\AmberGIS\Forums\MikeGarage\MikeGarage.accdb;"
+ "Persist Security Info=False";
// if you're using a password, use next line (??)
//((IOleDBConnectionInfo)wsf).SetParameters(connStr, "");
ps.SetProperty("CONNECTSTRING", connStr);
IWorkspace ws = wsf.Open(ps, 0);
IEnumDatasetName enumDsn = ws.get_DatasetNames(esriDatasetType.esriDTAny);
IDatasetName dsn;
while((dsn=enumDsn.Next())!= null)
Debug.Print(dsn.Name);
}