ADODB к запросу: ошибка времени выполнения 1004 - PullRequest
Новая
       8

ADODB к запросу: ошибка времени выполнения 1004

1 голос
/ 13 января 2020

В настоящее время я пытаюсь переместить проект, который запрашивает SQL Сервер из VBA из ODB C в ADODB. Ссылка на объект данных Active X и набор записей 2.8.

Соединение ADODB работает, и набор записей заполняется. Кажется, что набор записей и таблица запросов по каким-то причинам вне моего понимания не нравятся друг другу. Я пытался использовать любой тип With для объекта подключения.

Я сталкиваюсь с ошибкой времени выполнения '1004' Ошибка приложения или объекта.

Вот как выглядит код : 

Dim cn As Object
Dim rs As Object

Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")

With cn
    .Open "Driver={SQL Server};Server=xxx;Database=xxx;UID=xxx;PWD=xxx;"
    .CommandTimeout = 0
    Set rs = .Execute("Select 1")
End With

Debug.Print rs(0)

Dim qtData As QueryTable
Set qtData = ActiveSheet.QueryTables.Add(rs, Destination:=Range("A1"))
With qtData
     .Name = "DTBase"
     .FieldNames = True
     .RowNumbers = False
     .FillAdjacentFormulas = False
     .PreserveFormatting = True
     .RefreshOnFileOpen = False
     .BackgroundQuery = False
     .RefreshStyle = xlOverwriteCells
     .SavePassword = False
     .SaveData = False
     .AdjustColumnWidth = True
     .RefreshPeriod = 0
     .PreserveColumnInfo = False
     .BackgroundQuery = False
     .EnableEditing = False
 End With

'ActiveSheet.ListObjects.Add(xlSrcQuery, rs, Destination:=Selection).QueryTable.Refresh

qtData.Refresh
qtData.Close
qtData.Delete

rs.Close
cn.Close

Set rs = Nothing
Set cn = Nothing

1 Ответ

1 голос
/ 16 января 2020

По сути, вы сталкиваетесь с двумя проблемами в разных методах:

  • .Close: поскольку объект QueryTable не имеет объекта .Close метод, просто удалите вызов.

  • .Debug.Print: при вызове Debug.Print rs(0) вы, очевидно, используете набор записей и, таким образом, недоступны для QueryTables.Add(), который, по-видимому, требует нетронутого набора записей.

    Чтобы решить, рассмотрите возможность перемещения Debug.Print после QueryTables.Add() и вызова MoveFirst непосредственно перед тем, как таблица запросов переместит курсор в конец, где EOF = True. 

    Set qtData = ActiveSheet.QueryTables.Add(rs, Destination:=Range("A1"))

With qtData
     .Name = "DTBase"
     .FieldNames = True
     .RowNumbers = False
     .FillAdjacentFormulas = False
     .PreserveFormatting = True
     .RefreshOnFileOpen = False
     .BackgroundQuery = False           ' REMOVED REPEATED LINE AFTER THIS ONE
     .RefreshStyle = xlOverwriteCells
     .SavePassword = False
     .SaveData = False
     .AdjustColumnWidth = True
     .RefreshPeriod = 0
     .PreserveColumnInfo = False
     .EnableEditing = False
     .Refresh                           ' MOVED TO INSIDE With BLOCK
     .Delete                            ' MOVED TO INSIDE With BLOCK
End With

rs.MoveFirst
Debug.Print rs(0)

    Примечание. Я пытался запустить MoveFirst после Debug.Print, но безрезультатно. Кажется, QueryTables.Add() требует нетронутого набора записей, независимо от положения курсора. Это может отличаться для драйверов ODB C. 

    Debug.Print rs(0)
rs.MoveFirst

Set qtData = ActiveSheet.QueryTables.Add(rs, Destination:=Range("A1"))

With qtData
    ...

    .Refresh
    .Delete
End With
...