Excel VBA: ссылка на позднюю привязку

Question

Я пытаюсь написать код для надстройки в excel, который захватывает некоторые данные с SQL Server. Сам код работает безупречно, но почему-то что-то испортилось.

Кажется, что код будет работать нормально несколько раз, а затем внезапно выйдет из строя. После долгого времени я решил, что это имеет какое-то отношение к ссылкам, видя, что при сбое меняю ссылку «Microsoft ActiveX Data Objects 2.8 Library» на что-то еще, а затем обратно, надстройка будет работать еще раз.

Увидев, что перестройка надстройки не работает, я начинаю исследовать вариант позднего связывания. Я просто не могу понять, как это сделать.

Private Sub RetrieveToWorksheet(SQL As String, WriteTo As Range, Optional WriteColumnNames As Boolean = True) 

If GetStatus = "True" Then 
MsgBox ("Database is currently being updated. Please try again later.") 
Exit Sub 
End If 

Application.ScreenUpdating = False 

Dim Connection As ADODB.Connection 
Dim RecordSet As ADODB.RecordSet 
Dim Field As ADODB.Field 
Dim RowOffset As Long 
Dim ColumnOffset As Long 

    On Error GoTo Finalize 
Err.Clear 
Set Connection = New ADODB.Connection 
Connection.ConnectionTimeout = 300 
Connection.CommandTimeout = 300 
Connection.ConnectionString = "Provider=sqloledb;Data Source=vdd1xl0001;Initial Catalog=SRDK;User Id=SRDK_user;Password=password;Connect Timeout=300" 
Connection.Mode = adModeShareDenyNone 
Connection.Open 
Set RecordSet = New ADODB.RecordSet 
RecordSet.CursorLocation = adUseServer 
RecordSet.Open SQL, Connection, ADODB.CursorTypeEnum.adOpenForwardOnly 
RowOffset = 0 
ColumnOffset = 0 

If WriteColumnNames = True Then 
For Each Field In RecordSet.Fields 
    WriteTo.Cells(1, 1).Offset(RowOffset, ColumnOffset).Value = Field.Name 
    ColumnOffset = ColumnOffset + 1 
Next 
ColumnOffset = 0 
RowOffset = 1 
End If 

WriteTo.Cells(1, 1).Offset(RowOffset, ColumnOffset).CopyFromRecordset RecordSet 

Finalize: 

    If Not RecordSet Is Nothing Then 
     If Not RecordSet.State = ADODB.ObjectStateEnum.adStateClosed Then RecordSet.Close 
     Set RecordSet = Nothing 
    End If 
    If Not Connection Is Nothing Then 
     If Not Connection.State = ADODB.ObjectStateEnum.adStateClosed Then Connection.Close 
     Set Connection = Nothing 
    End If 
    If Err.Number <> 0 Then Err.Raise Err.Number, Err.Source, Err.Description 
End Sub 

Короче говоря: я просто хочу, чтобы надстройка автоматически добавляла ссылку «Microsoft ActiveX Data Objects 2.8 Library».

Вся помощь очень признательна!

Answer 1

В ответ на ваш вопрос о позднем связывании, это связано с заменой строки кода

Dim Connection As ADODB.Connection 

с

Dim Connection As object 

и замена

Set Connection = New ADODB.Connection 

с

Set Connection = GetObject(, "ADODB.Connection") 

И аналогично для других объектов из этой библиотеки.

Теперь я не уверен, что это исправит проблему, с которой вы столкнулись. Похоже, в библиотеке ActiveX есть ошибка, и вы нажимаете на нее, хотя ничего, что вы делаете, кажется особенно эзотерическим.