HOW TO
Note: The information in this article applies to ArcGIS versions 9.x only. Visual Basic for Applications (VBA) for ArcMap and ArcCatalog has been deprecated at ArcGIS 10.
Instructions provided explain how to create a new personal geodatabase programmatically using VBA code.
Follow the steps below:
Note: If there is an existing UIButtonControl or a desire to change the name of the UIButtonControl, the change to the UIButtonControl code portion below needs to be made accordingly before the button can be used.
Private Sub UIButtonControl1_Click() CreateGeodb End Sub Private Sub CreateGeodb() Dim pGxApp As IGxApplication Set pGxApp = Application Dim pSelObj As IGxObject Set pSelObj = pGxApp.SelectedObject Debug.Print pSelObj.Category If pSelObj.Category = "Folder" Or pSelObj.Category = "Folder Connection" Then Dim location As String location = pSelObj.FullName Dim name As String name = "mydb" Dim mypath As String mypath = location & "\" & name & ".mdb" Dim bWorkspExist As Boolean bWorkspExist = PgdbExists(mypath) If bWorkspExist = False Then Call createAccessWorkspace(location, name) Call AddGeodb(mypath) pGxApp.Refresh location MsgBox mypath & " has been created.", vbInformation Else MsgBox "The " & name & " PGDB already exists in the current location.", vbExclamation Exit Sub End If Else MsgBox "A Personal Geodatabase cannot be created at this location." & vbNewLine & "Please select a folder location.", vbExclamation Exit Sub End If End Sub Private Function PgdbExists(mypath As String) As Boolean Dim pGPValue As IGPValue Set pGPValue = New DEWorkspace pGPValue.SetAsText mypath Dim pDEUtil As IDEUtilities Set pDEUtil = New DEUtilities PgdbExists = pDEUtil.Exists(pGPValue) End Function '' '' createAccessWorkspace '' NOTE: '' Location does not have to contain ending '\' '' Name should not contain .mdb extension Public Function createAccessWorkspace(location As String, name As String) _ As IWorkspaceName On Error GoTo EH Set createAccessWorkspace = Nothing ' create the Access Workspace factory Dim pWorkspaceFactory As IWorkspaceFactory Set pWorkspaceFactory = New AccessWorkspaceFactory Dim pWorkspaceName As IWorkspaceName Set pWorkspaceName = pWorkspaceFactory.Create(location, name, Nothing, 0) Set createAccessWorkspace = pWorkspaceName Exit Function EH: MsgBox Err.Number, vbInformation, "createAccessWorkspace" End Function Sub AddGeodb(mypath As String) Dim pwf As IWorkspaceFactory Set pwf = New AccessWorkspaceFactory Dim pfws As IFeatureWorkspace Set pfws = pwf.OpenFromFile(mypath, 0) End Sub
Article ID:000008645
Get help from ArcGIS experts
Download the Esri Support App