Excel VBA: Late binding reference - excel

I'm trying to write some code for an add-in in excel, which grabs some data from an SQL Server. The code itself is working flawlessly, but somehow something got corrupted.
It seems that the code will work fine a few times and then all of a sudden trigger an excel-crash. After a long time I've determined that it has something to do with the references, seeing as if upon crash I change the reference 'Microsoft ActiveX Data Objects 2.8 Library' to something else, and then back again, the add-in will work again.
Seeing as rebuilding the add-in doesn't work, I'm beginning to explore the option of late-binding. I just can't seem to understand how to do it.
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
Long story short: I just want the add-in to automatically add the reference 'Microsoft ActiveX Data Objects 2.8 Library'.
All help is greatly appreciated!

In answer to your question about late binding, this involves replacing the line of code
Dim Connection As ADODB.Connection
with
Dim Connection As object
and replacing
Set Connection = New ADODB.Connection
with
Set Connection = GetObject(, "ADODB.Connection")
And similarly for the other objects from that library.
Now, I am not sure if this will fix the actual issue that you are having. It sounds like there is a bug in the ActiveX library and you are hitting it, although nothing you are doing seems particularly esoteric.

Related

How do I close an Excel spreadsheet in VBA code?

I have the following routine below that is meant to open an Excel spreadsheet and then go row by row to import the results into a table that is passed in. It works fine but the problem is if I try to open that same spreadsheet a second time I get a message that the file is in use and I have to Ctrl-Alt-Del to shut down Excel before I can use it again. I thought that the Set mySheet=Nothing and Set xlApp=Nothing would release the file but apparently not. What more can I do to make sure that Access lets go of the Excel file? Thanks in advance!
Public Sub MakeTempTable(strFilePath As String, tablename As String)
Dim mySheet As Object
Dim xlApp As Object
Dim rs As DAO.Recordset
Dim sql As String
sql = "DELETE * FROM " & tablename
DoCmd.RunSQL sql
Set rs = CurrentDb.OpenRecordset(tablename)
Set xlApp = CreateObject("Excel.Application")
Set mySheet = xlApp.Workbooks.Open(strFilePath).Sheets(1)
xlApp.Visible = False
Set mySheet = xlApp.Sheets("Input")
Dim dRows As Double
dRows = 1
Dim dRow As Double, dCol As Double
dRow = 2
On Error GoTo ERR
Do
dCol = 1
rs.AddNew
If mySheet.cells(dRow, 3) = "" Then Exit Do
Do
If mySheet.cells(dRow, dCol).Value <> "_END_" Then
rs.Fields(dCol).Value = Nz(mySheet.cells(dRow, dCol).Value, "")
dCol = dCol + 1
Else
Exit Do
End If
Loop
rs.Update
dRow = dRow + 1
Loop
EXITSUB:
Set mySheet = Nothing
Set xlApp = Nothing
Exit Sub
ERR:
If ERR.Number = 3265 Then MsgBox "The species selected are incompatible. Canceling import.", vbCritical, "IMPORT ERROR"
GoTo EXITSUB
End Sub
Try using
xlApp.Quit
When you set xlApp to nothing you are only clearing the object within the procedure, you aren't doing anything to the actual Excel instance. All that setting XXX = nothing allows you to do is then reuse that object.
You will need to legally close the workbooks that are open as in
xlApp.Workbooks.Close
EXITSUB:
This will close the instances that are open.
Prior to this, kill all the instances or reboot your machine to clear all the instances that are open.

Bringing data from sql server - existing data not brought

I have a function that brings data from sql server. The function is tested and is used in many macros. Now I am trying to use it and for some reason it doesn't work, although I am testing the query and it does have data
I opened a macro where the function works and try to test it from there, but still doesn't work.
I am calling to function GetDataFromDatabase (see below) from the following code:
Sub testing()
Dim query As String
Dim ImportedData As Range
query = GetQuery
Debug.Print query
Call GetDataFromDatabase(query, Range("AB1"), False)
End Sub
Note, that when debug.pring prints the query, I take it, run in in the database and I get the data, so the GetQuery function works.
The function includes the following line:
On Error GoTo CloseConnection
And indeed, at some point it goes to closeConnection (line marked below in the function). How do I know what is the error?
Sub GetDataFromDatabase(query As String, cellToCpyData As Range, WithHeaders As Boolean)
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim LocalDBCon As ADODB.Connection
Dim SqlTableDatasSet As ADODB.Recordset
Dim SqlDataSetFields As ADODB.Field
Dim Ctr As Long
Dim RDBConString As String
RDBConString = "connection string (the right one)"' This here is ok, I deleted the actual sting
Set LocalDBCon = New ADODB.Connection
Set SqlTableDatasSet = New ADODB.Recordset
LocalDBCon.ConnectionString = RDBConString
On Error GoTo CloseConnection
LocalDBCon.Open
With SqlTableDatasSet
.ActiveConnection = LocalDBCon
.ActiveConnection.CommandTimeout = 0
.Source = query
.LockType = adLockReadOnly
.CursorType = adOpenForwardOnly
.Open
End With
'Adding the sql table headers
If WithHeaders Then
Ctr = 0
For Each SqlDataSetFields In SqlTableDatasSet.Fields
cellToCpyData.Offset(0, Ctr) = SqlDataSetFields.Name
Ctr = Ctr + 1
Next SqlDataSetFields
Set cellToCpyData = cellToCpyData.Offset(1, 0)
End If
---->>cellToCpyData.CopyFromRecordset SqlTableDatasSet 'When not working, jumps from here to CloseConnection<<------------------------------------
SqlTableDatasSet.Close
Wrapup:
On Error Resume Next
LocalDBCon.Close
Exit Sub
CloseConnection:
On Error Resume Next
LocalDBCon.Close
End Sub
You need to add this line of code between "CloseConnection:" and "On Error Resume Next"
Debug.Print Err.Number & " - " & Err.Description
This will print to the immediate window what error is causing the problem. That will give a starting point to go from.

Loop through Access database and perform basic operations using Excel VBA

I have been performing these operations through excel, but the raw data that I am dealing with is overwhelming for excel. I shifted over to access as the database but I am trying to find similar functionality. I am still using excel as my interface.
I am essintially breaking my data into samples. Taking a sample of the data, analyzing it then moving on to the next sample. I would like to do the same with the Access data. What I am looking for is how to perform operations (summation, multipication, division,max, min...) on a sample using a for loop. Also, what is the ID of max value and ID on the min value. I am also dealing with a huge amout of raw data, so the less lines of code would be optimal. Any pointers in the right direction would be appreciated.
Code in Excel:
For CoUnTer = 1 To FindRecordCount
Set Circ_Rng = WS.Range(WS.Cells(CoUnTer , 5), WS.Cells(CoUnTer + TempTimeFrame - 1, 5))
Set DataPoint_Rng = WS.Range(WS.Cells(CoUnTer , 1), WS.Cells(CoUnTer + TempTimeFrame - 1, 1))
Set DataPoint_Circ_Rng = WS.Range(WS.Cells(CoUnTer , 8), WS.Cells(CoUnTer + TempTimeFrame - 1, 8))
Set DataPoint_SQ_Rng = WS.Range(WS.Cells(CoUnTer , 9), WS.Cells(CoUnTer + TempTimeFrame - 1, 9))
'---------------------------
MaxPoint = WorksheetFunction.Max(CircPressure_Rng)
Row_At_MaxPressure = WS.Columns(5).Cells.Find(MaxPoint, After:=WS.Cells(3, 5), SearchOrder:=xlByRows, LookIn:=xlValues, SearchDirection:=xlNext).Row
Sigma_X_Sigma_Y = WorksheetFunction.Sum(Circ_Rng) * WorksheetFunction.Sum(DataPoint_Rng)
Sigma_XY = WorksheetFunction.Sum(DataPoint_Circ_Rng)
Sigma_X2 = WorksheetFunction.Sum(DataPoint_SQ_Rng)
Min_X = WorksheetFunction.Min(DataPoint_Rng)
Code for Access data:
This code gets the data sample. What I am missing how can I handle the operations on them similar to what I have done in excel.
Sub GetAccessData()
Dim DBFullName As String
Dim Connect As String, Source As String
Dim Connection As ADODB.Connection
Dim Recordset As ADODB.Recordset
Dim Col As Long
Dim x As Long
Application.ScreenUpdating = False
'DataBase Path
DBFullName = WB_Path & "\RawData - Template.accdb"
'Open the Connection
Set Connection = New ADODB.Connection
Connect = "Provider=Microsoft.ACE.OLEDB.12.0;"
Connect = Connect & "Data Source=" & DBFullName & ";"
Connection.Open ConnectionString:=Connect
'Create a RecordSet
Set Recordset = New ADODB.Recordset
' Client-side cursor
Recordset.CursorLocation = adUseClient
With Recordset
Source = "SELECT * FROM RawData WHERE [ID] BETWEEN " & StartofData & " AND " & EndofData
.Open Source:=Source, ActiveConnection:=Connection
On Error Resume Next
End With
EndofData = Recordset.RecordCount
Set Recordset = Nothing
Connection.Close
Set Connection = Nothing
'Application.ScreenUpdating = True
'Application.EnableEvents = True
End Sub
As you are seeing, Excel is better for some things and Access is better for some things. Sometimes you can literally substitute Access for Excel, and vice versa, but often each one should be used for it's intended purpose. There are probably a few ways forward here, but I would lean towards leaving your Excel stuff in Excel, and control Excel from Access. You can use Late Binding or Early Binding to control one app from another app. Here are two options for you to consider.
‘EARLY BINDING
Option Compare Database
Option Explicit ' Use this to make sure your variables are defined
' One way to be able to use these objects throughout the Module is to Declare them
' Here and not in a Sub
Private objExcel As Excel.Application
Private xlWB As Excel.Workbook
Private xlWS As Excel.Worksheet
Sub Rep()
Dim strFile As String
strFile = "C:\your_path_here\YourExcelFile.xls"
' Opens Excel and makes it Visible
Set objExcel = New Excel.Application
objExcel.Visible = True
'Opens up the Workbook
Set xlWB = objExcel.Workbooks.Open(strFile)
'Sets the Workseet to the last active sheet - Better to use the commented version and use the name of the sheet.
Set xlWS = xlWB.ActiveSheet
'Set xlWS = xlWB("Sheet2")
With xlWS ' You are now working with the Named file and the named worksheet
End With
'Do Close and Cleanup
End Sub
 
‘LATE BINDING
Sub ControlExcelFromAccess()
' No reference to a type library is needed to use late binding.
' As long as the object supports IDispatch, the method can
' be dynamically located and invoked at run-time.
' Declare the object as a late-bound object
Dim oExcel As Object
Dim strFile As String
strFile = "C:\your_path_here\YourExcelFile.xls"
Set oExcel = CreateObject("Excel.Application")
' The Visible property is called via IDispatch
oExcel.Visible = True
Set xlWB = oExcel.Workbooks.Open(strFile)
'Call code here . . .
Set oExcel = Nothing
End Sub
Just copy/paste your code inside this code, make a few small tweaks if necessary, and you should be good to go!

VBA - How to Clear a Connection String From a Connection

I have a function that attempts to clear every connection string from every connection, it works as follows:
Public Sub RemovePasswordByNamePrefix()
Dim w As Worksheet
Dim qt As QueryTable
Dim cn As Object
Dim odbcCn As ODBCConnection
Dim oledbCn As OLEDBConnection
For Each cn In ThisWorkbook.connections
If cn.Type = xlConnectionTypeODBC Then
Set odbcCn = cn.ODBCConnection
odbcCn.SavePassword = False
odbcCn.connection = ""
odbcCn.CommandText = ""
ElseIf cn.Type = xlConnectionTypeOLEDB Then
Set oledbCn = cn.OLEDBConnection
oledbCn.SavePassword = False
oledbCn.connection = ""
oledbCn.CommandText = ""
End If
Next
End Sub
The issue is that this fails, with the following error(at the OLEDB section, connection = ""):
Run time error '1004'
Application defined or object-defined error
Attempting to do this by the interface doesn't work either, it's a little funky:
When you click the "OK" button, it just doesn't do anything... like the window doesn't close, no change, it's very strange. Actually this same behavior will persist unless you put something(valid or invalid) in the command text and command string sections...
Why is this the case? Is there a way to get around it? It's almost like MS put this as a "hidden" requirement and didn't document or provide feedback when the user/developer attempts to route around it.
The obvious question I'll receive on this is, why would I want to do this, I'll will open another ticket to address that, and add a link here
Try instead; delete the connection and recreate later when you need it.
Public Sub RemovePasswordByNamePrefix()
Dim w As Worksheet
Dim qt As QueryTable
Dim cn As Object
Dim odbcCn As ODBCConnection
Dim oledbCn As OLEDBConnection
For Each cn In ThisWorkbook.Connections
If cn.Type = xlConnectionTypeODBC Then
cn.Delete
ElseIf cn.Type = xlConnectionTypeOLEDB Then
cn.Delete
End If
Next
End Sub

Excel VBA Object required error when populating ComboBox

I am getting the following error --
Run-time error '424' : Object required
Here is the code where I am getting the error message. The line where the error appears has been highlighted with ****
Sub LoadDropdown_Click()
Dim cnt As ADODB.Connection
Dim rst As ADODB.Recordset
Dim stDB As String, stSQL As String
Dim xlCalc As XlCalculation
Dim vaData As Variant
Dim k As Long
Set cnt = New ADODB.Connection
cnt.connectionString = Module1.GetConnectionString
stSQL = "EXEC dbo.GetData"
With cnt
.CursorLocation = adUseClient 'Necesary for creating disconnected recordset.
.Open stConn 'Open connection.
'Instantiate the Recordsetobject and execute the SQL-state.
Set rst = .Execute(stSQL)
End With
With rst
Set .ActiveConnection = Nothing 'Disconnect the recordset.
k = .Fields.Count
'Populate the array with the whole recordset.
vaData = .GetRows
End With
'Close the connection.
cnt.Close
'Manipulate the Listbox's properties and show the form.
With ComboBox21
.Clear ' **** the error comes at this line since ComboBox21 is empty ******
.BoundColumn = k
.List = Application.Transpose(vaData)
.ListIndex = -1
End With
Dim i As Integer
'Release objects from memory.
Set rst = Nothing
Set cnt = Nothing
End Sub
These are the things I have veified --
The ComboBox actually exists in Sheet1, called Priorities. See this screenshot showing that Sheet1 contains a Combobox called ComboBox21
The below function, LoadDropdown_Click is present in Sheet1. See this screenshot for details
This code works when running from certain machines. It used to work on my machine earlier, but now I am getting this error suddenly without having made any changes to the code or the environment.
I tried changing ComboBox21 to Sheet1.ComboBox21, but I got a compile error - Method or Data member not found.
It will be great if someone can help!
Please change your code:
With ComboBox21
.Clear ' **** the error comes at this line since ComboBox21 is empty ******
.BoundColumn = k
.List = Application.Transpose(vaData)
.ListIndex = -1
End With
'With the below:
Sheet1.ComboBox21.Clear
With Sheet1.ComboBox21
.BoundColumn = k
.List = Application.Transpose(vaData)
.ListIndex = -1
End With
Basically, you just add "On Error Resume Next" to avoid those annoying error messages popping up and then add "Err.Clear" to clear the error flag just in case.
Private Sub ComboBox1_Change()
On Error Resume Next
ComboBox5.List = Sheets("Data").Range("B1:B6").Value
Err.Clear
End Sub
NOTE: This is probably not the right way of doing things but at least it works on my end

Resources