Извлеките соединение MDB с базой данных в файл MDB в ArcGis 9.3 - PullRequest
Новая
       14

Извлеките соединение MDB с базой данных в файл MDB в ArcGis 9.3

0 голосов
/ 25 сентября 2019

Мне нужно решить эту проблему для запроса.

Мне нужно создать код для VBA для извлечения всех таблиц для этого подключения, в Arcgis 9.3 , это мой код: 

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 = "Spatial Database Connection" Then
        Dim location As String

        nombreSinExtension = Left(pSelObj.FullName, InStr(pSelObj.FullName, ".") - 1)
        Dim name As String
        name = Replace(nombreSinExtension, "Database Connections\", "", 1, 1)
        location = "D:\RespaldoBDServidores\" & removePrefix
        'MsgBox "Ingrese nombre de la nueva MDB"
        'name = InputBox("Nuevo nombre de MDB")
        nameConnection = Replace(name, "GAL04 ", "", 1, 1)
        Dim mypath As String
        mypath = location + name & ".mdb"
        Dim bWorkspExist As Boolean
        bWorkspExist = PgdbExists(mypath)
        If bWorkspExist = False Then
           On Error GoTo EH
            Call createAccessWorkspace(location, name)
            Call AddGeodb(mypath)
            pGxApp.Refresh location
            Dim fs As Object
            Set fs = CreateObject("esriGeoprocessing.GpDispatch.1")
            Dim rutaServidor As String
            Dim newNameServer As String
            newNameServer = Replace(pSelObj.FullName, "Database Connections", "\", 1, 1)
            rutaServidor = newNameServer + "\" + nameConnection + ".ElevaL"
           ''LINE ERROR'' 
           fs.CopyFeatures_management rutaServidor, mypath
           ''LINE ERROR'' 

            MsgBox mypath & " has been created.", vbInformation
EH:
            MsgBox Err.Number, vbInformation, "Error en copia de datos: "

        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

Когда я нажимаю в UiButtonControl , это принимает имя соединения с базой данных (в моем случае, «GAL04 SECCIONC_BASE»), у этого соединения есть несколько функций, которые называются как «ElevaL» или"ElevaP" и вручную, я должен выбрать, скопировать и вставить в новую персональную базу геоданных, но я думаю, что процедура должна быть автоматически.Итак, я беру имя, создаю новый MDB с его именем и копирую эти функции, но эта процедура вызывает ошибку в строке метки.

У ошибки EH просто есть номер: -2147467259

Пожалуйста, помогите

...