Excel VBA: late binding reference

I am trying to write add-in code in excel that captures some data from SQL Server. The code itself works flawlessly, but somehow something went wrong.

It seems that the code will work fine several times, and then suddenly fail. After a long time, I decided that this had something to do with the links, seeing that upon failure I would change the "Microsoft ActiveX Data Objects 2.8 Library" link to something else, and then back, the add-in would work again.

When I see that rebuilding an add-in does not work, I begin to explore the late binding option. I just can't figure out how to do this.

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

In short: I just want the add-in to automatically add the "Microsoft ActiveX Data Objects 2.8 Library" link.

All help is much appreciated!

+2
1

Dim Connection As ADODB.Connection

Dim Connection As object

Set Connection = New ADODB.Connection

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

.

, , . , ActiveX , , , , .

+5

Source: https://habr.com/ru/post/1608832/


All Articles