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
Related
I am working on a project where I'm using SQL to return records from a database into a listbox using userinput. Things are fine when there's more than one result, the listbox reads properly. However, when there's only one record, it doesn't transpose it like it does with all the others. Multiple Returns Single Return
I've tried to do an "if employeeoutput.recordcount = 1 then don't transpose" type of thing, but that still sends me with the Single Return.
Private Sub cmdSearch_Click()
Stop
'connect to database
'make dynamic code
'profit
'set up DB and Recordset
Dim calldbconn As ADODB.Connection
Dim EmployeeOutput As ADODB.Recordset
Dim EmpData As Variant
'its a special tool we're going to use later
Dim InContactInput As String
Dim FNameInput As String
Dim LNameInput As String
Dim TeamNameInput As String
Dim TeamNumberInput As Integer
Dim SQLString As String
'set it up for a new recordset
Set calldbconn = New ADODB.Connection
Set EmployeeOutput = New ADODB.Recordset
'set the vars
InContactInput = txtInContactNum.Value
FNameInput = txtFirstName.Value
LNameInput = txtLastName.Value
TeamNameInput = cboTeamName.Value
TeamNumberInput = cboTeamName.ListIndex + 1
'---------A bunch of stuff here to build the SQL String----------
'----------------------------------------------------------------
'Time to connect
calldbconn.ConnectionString = StrCallDB
calldbconn.Open
On Error GoTo CloseConnection
With EmployeeOutput
.ActiveConnection = calldbconn
.Source = SQLString
.LockType = adLockOptimistic
.CursorType = adOpenKeyset
.Open
EmpData = .GetRows
On Error GoTo CloseRecordset
End With
'And now, the list box
With lstResults
.Clear
.List = Application.Transpose(EmpData)
End With
'close and reset
CloseRecordset:
EmployeeOutput.Close
CloseConnection:
calldbconn.Close
Set EmployeeOutput = Nothing
Set calldbconn = Nothing
End Sub
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.
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.
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
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.