ошибка: «Ошибка приложения или объекта» при использовании CopyFromRecordset - Excel macos - PullRequest
Новая
       61

ошибка: «Ошибка приложения или объекта» при использовании CopyFromRecordset - Excel macos

0 голосов
/ 27 апреля 2020

Я вызываю данные из базы данных PostgreSQL в электронную таблицу Excel, используя следующий макрос: 

Sub sub_copy_Recordset()

    Dim objRecordset As Recordset
    Dim strConnection As String
    Dim input_portfolio, setRange As String
    Dim end_date As Date
    Dim i, record_count As Integer

    input_portfolio = ActiveWorkbook.Sheets("_portfolio").Range("main").Cells(1, 1).Value
    end_date = ActiveWorkbook.Sheets("_portfolio").Range("main").Cells(2, 1).Value
    ini_date = ActiveWorkbook.Sheets("_portfolio").Range("main").Cells(3, 1).Value

    On Error GoTo ErrHandler

        strConnection = "Driver={PostgreSQL Unicode};Server=[ip];Port=5432;Database=[db];UID=user;PWD=[pwd];"
        Set objConnection = New ADODB.Connection
        Set objRecordset = New ADODB.Recordset
        objRecordset.CursorLocation = adUseClient
        objConnection.Open strConnection

        With objRecordset
            .ActiveConnection = objConnection
            .Open "SELECT * FROM portfolio_positions('" & input_portfolio & "','" & end_date & "');"
        End With

        With ActiveWorkbook.Sheets("_tables")
            .Range("A2").CopyFromRecordset objRecordset
            record_count = objRecordset.RecordCount
            objRecordset.Close
            Set objRecordset = Nothing
        End With

objConnection.Close
Set objConnection = Nothing

    MsgBox "End Sub"

Exit Sub

ErrHandler:

    Debug.Print Err.Number & "  " & Err.Description
End Sub

Когда макрос выполняет строку, в которую я копирую набор записей в ячейку "A2" .Range("A2").CopyFromRecordset objRecordset он копирует данные в A2 и переходит к концу Sub и выполняет строку MsgBox "End Sub". Когда я добавляю дополнительные инструкции под строкой CopyFromRecordset следующим образом: 

Sub sub_copy_Recordset()

    Dim objRecordset As Recordset
    Dim strConnection As String
    Dim input_portfolio, setRange As String
    Dim end_date As Date
    Dim i, record_count As Integer

    input_portfolio = ActiveWorkbook.Sheets("_portfolio").Range("main").Cells(1, 1).Value
    end_date = ActiveWorkbook.Sheets("_portfolio").Range("main").Cells(2, 1).Value


    On Error GoTo ErrHandler

        strConnection = "Driver={PostgreSQL Unicode};Server=79.143.185.46;Port=5432;Database=fincerec_canaima;UID=fincerec_user;PWD=_Or0cua1@;"
        Set objConnection = New ADODB.Connection
        Set objRecordset = New ADODB.Recordset
        objRecordset.CursorLocation = adUseClient
        objConnection.Open strConnection

        With objRecordset
            .ActiveConnection = objConnection
            .Open "SELECT * FROM portfolio_positions('" & input_portfolio & "','" & end_date & "');"
        End With

        With ActiveWorkbook.Sheets("_tables")
            .Range("A2").CopyFromRecordset objRecordset
            record_count = objRecordset.RecordCount
            objRecordset.Close
            Set objRecordset = Nothing

            .Columns("A").ColumnWidth = 20
            .Columns("B").ColumnWidth = 5
            With .Columns("C:G")
                .ColumnWidth = 12
                .NumberFormat = "#,##0.00"
                .HorizontalAlignment = xlRight
            End With
            setRange = "A" & record_count + 2 & ":G1000"
            .Range(setRange).ClearContents
            setRange = "A2:G" & record_count + 1
            .Names("_positionsRange").Delete
            .Range(setRange).Name = "_positionsRange"
        End With

objConnection.Close
Set objConnection = Nothing

    MsgBox "End Sub"

Exit Sub

ErrHandler:

    Debug.Print Err.Number & "  " & Err.Description
End Sub

Копирует набор записей в ячейку A2, но затем переходит к ErrHandler: и затем сообщает об ошибке

1004 Приложение определенная или определенная объектом ошибка

Любая помощь приветствуется.

...