English

How To: Create a new personal geodatabase using VBA

Summary

Instructions provided explain how to create a new personal geodatabase programmatically using VBA code.

Procedure

Follow the steps below:

  1. Start ArcCatalog.
  2. Create a new UIButtonControl

    A. Select Tools > Customize to open the Customize dialog box.
    B. Select the Commands tab.
    C. Select [UIControls] from the Categories list box.
    D. Select Untitled from the Save In drop-down list to save the button to this map document. Select Normal to save the button to all ArcMap documents on the machine.
    E. Click New UIControl.
    F. Select UIButtonControl and click Create.
    G. Drag the new UIButtonControl to the toolbar of choice.
    H. Close the Customize dialog box.



    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.

  3. Open Visual Basic Editor.

    In ArcCatalog, select Tools > Macros > Visual Basic Editor.

  4. In the Project Explorer window, expand the 'Normal (Normal.gxt)' item and select ArcCatalog Objects > ThisDocument. Right-click and select View Code.
  5. Paste the following code into the code module.

    Code:
    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

  6. Click the New button to create a new personal geodatabase.

Related Information