I am trying to populate my combobox through an adodb connection and recordset with data from an access database. The code has previously run fine but in a normal userform, my issue is that I can't properly reference to the combobox.additem property.
How do I reference to it when the ActiveX object is directly on the worksheet "Mainwindow"?
The codename of the shape is: CombBox_Instruments
The control code name should be: Forms.ComboBox.1
I have market where I get the error, the current error is: Run time error 1004: Application defined or object defined error
Here is my code
Private Sub Workbook_Open()
Dim DataConnection As ADODB.Connection: Set DataConnection = New ADODB.Connection
Dim RecordSet As ADODB.RecordSet: Set RecordSet = New ADODB.RecordSet
Dim SQLString As String
Const ConnectionPath As String = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\Users\name\Desktop\Database.accdb;Persist Security Info=False;"
DataConnection.ConnectionString = ConnectionPath
DataConnection.Open
SQLString = "SELECT Name FROM MSysObjects WHERE Type =1 AND Flags=0"
With RecordSet
.ActiveConnection = DataConnection
.Source = SQLString
.LockType = adLockReadOnly
.CursorType = adOpenForwardOnly
.Open
End With
Do Until RecordSet.EOF = True
If RecordSet.Fields(0) <> "Instruments" Then
Debug.Print RecordSet.Fields(0)
Sheets("Mainwindow").OLEObjects("Forms.ComboBox.1").AddItem RecordSet.Fields(0) - ISSUE IS HERE!
RecordSet.MoveNext
Else
RecordSet.MoveNext
End If
Loop
End Sub
Assuming the Combo Box named CombBox_Instruments is on the sheet "Mainwindow" your code should be:
Sheets("Mainwindow").CombBox_Instruments.AddItem RecordSet.Fields(0)
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'm getting the runtime error 91 after I try a to send a sql statement in my excel application. Here's the following code:
'Module Consts:
Public rst1 As New ADODB.Recordset 'defined in a constants module
'Module Conn:
Public Sub GetDynSQLQuery(ByVal strQuery$, ByVal rs As ADODB.Recordset)
Set rs = Nothing
If cn = "" Then Call ConnectToDb 'Sub set the variable "cn" with connectionstring to db and open the connection
With rs
.Source = strQuery 'Here comes the error
.ActiveConnection = cn
.CursorType = adOpenForwardOnly
.LockType = adLockReadOnly
.Open
End With
End Sub
'Form1:
strSql = "SELECT * FROM tbl1"
Call GetDynSQLQuery(strSql, rst1)
Error Message:
Object variable or With-block variable not set
What I'm doing wrong I cannot see it.
The first thing you do in the sub is that you empty the Argument (with Set rs = Nothing) that you just passed and then you use rs again.
So except if rs is a Public-like variable and it's filled in ConnectToDb,
it remains empty before being used, ergo the error!
First, try to remove Set rs = Nothing and if it's not enough, you'll need to look into ConnectToDb!
Secondly, you modify the Recordset inside the sub, but you try it to use it outside.
And the problem here was the use of ByVal, which pass a copy of the reference of the Object and so you canNOT modify the initial object, ergo the fact that the RecordSet is empty outside of the Sub! ;)
And as OP tested rst1.RecordCount > 0 which was false (rst1.RecordCount was equal to -1),
He fixed it by setting .CursorType to adOpenKeySet instead of adOpenForwardOnly
Public Sub GetDynSQLQuery(ByVal strQuery$, rs As ADODB.Recordset)
'Sub set the variable "cn" with connectionstring to db and open the connection
If cn = vbNullString Then Call ConnectToDb
With rs
.Source = strQuery 'No more error!^^
.ActiveConnection = cn
.CursorType = adOpenKeySet
.LockType = adLockReadOnly
.Open
End With
End Sub
I have Excel VBA code that runs a select query on an access database and returns a recordset. The connection works fine. When I get the recordset, I can access each field in each row fine. Here is what I am currently using:
Sub accessSelect(sql)
Set rs = New ADODB.Recordset
Call accessConnection
With rs
.Open sql, conn
End With
Do While Not rs.EOF
'rtvEditForm.rtvList is a list box.
rtvEditForm.rtvList.AddItem rs(1) & " - " & rs(2)
rs.MoveNext
Loop
End Sub
I want to be able to throw the whole rs in the rtvEditForm.rtvList without having to refer to each field. I've tried rtvEditForm.rtvList.AddItem rs, but that does not work because I get a "Type Mismatch" error.
Seems simple but I just can't figure this out. How would I do that with my current code?
No need to do any looping. A listbox has a recordset property which can be bound to an ADO recordset.
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Set cn = New ADODB.Connection
Set cn = CurrentProject.Connection
Set rs = New ADODB.Recordset
With rs
Set .ActiveConnection = cn
.Source = sql
.LockType = adLockOptimistic
.CursorType = adOpenKeyset
.Open
End With
Set Me.rtvList.Recordset = rs
rtvList.ColumnCount = rs.Fields.Count
All I want to do is use VBA to get the results of some query into an Excel workbook instead. The main issue is that the openRecordSet method appears to not be working. Every time when I try debugging it I see that the recordset (rcset) is Nothing. When I just run the query so it is viewed in the Access viewer, it seems to work just fine (see last line of code). I get no errors when I run the code, so I'm having a very hard time understanding why my recordset would return Nothing. I've searched around the internet quite a bit, but haven't found anyone in this particular situation. Thanks in advance for any help!
Dim db As DAO.Database
Dim qdef As DAO.QueryDef
Dim rcset As DAO.Recordset
Dim i As Integer
'Identify the database and query
Set db = CurrentDb
On Error Resume Next
With db
.QueryDefs.Delete ("RealQuery")
Set qdef = .CreateQueryDef("RealQuery", strSQLRQ)
.Close
End With
'The problem child line
Set rcset = qdef.OpenRecordset()
'Clear previous contents
Dim xlApp As Object
Set xlApp = CreateObject("Excel.Application")
With xlApp
.Visible = True
.Workbooks.Add
.Sheets("Sheet1").Select
'Copy the recordset to Excel
.ActiveSheet.Range("A2").CopyFromRecordset rcset
'Add column heading names to spreadsheet
For i = 1 To rcset.Fields.Count
xlApp.ActiveSheet.Cells(1, i).Value = MyRecordset.Fields(i - 1).Name
Next i
xlApp.Cells.EntireColumn.AutoFit
End With
qdef.Close
Set qdef = Nothing
Set db = Nothing
DoCmd.OpenQuery "RealQuery", acViewNormal
Option Explicit
Public Const strQry = "insert sql select command here"
Public Const conStr = "insertconnectionstringhere";
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Sub sql2excell()
Set cn = New ADODB.Connection
Set rs = New ADODB.Recordset
cn.Open (conStr)
rs.Open strQry, cn
If Not rs.EOF Then
ActiveSheet.Range("A1").CopyFromRecordset rs
End If
rs.Close
cn.Close
End Sub
Simplest SQL to excel vba i can get
I'm new in creating pivot tables in VBA. I'm curious to why my closed connections don't seem to affect existing connections? Also, I'm not able to refresh the table, I assume it is because VBA closes all connections when the procedure hits the end sub statement.
How can I make my pivot table refreshable and why do the connections always apprear in the existing connections even though they should be closed?
My code
Private Sub PivotAccessADODB()
' Link Pivottable to access database
Const ConnectionPath As String = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\Users\name\Desktop\DataBase.accdb;Persist Security Info=False;"
Dim DataConnection As ADODB.Connection: Set DataConnection = New ADODB.Connection
Dim RecordSet As ADODB.RecordSet: Set RecordSet = New ADODB.RecordSet
DataConnection.ConnectionString = ConnectionPath
DataConnection.Open
Dim SQLString As String: SQLString = "SELECT * FROM ALFA"
With RecordSet
.ActiveConnection = DataConnection
.Source = SQLString
.LockType = adLockReadOnly
.CursorType = adOpenForwardOnly
.Open
End With
' Initiate accept of external data
Dim PTCache As PivotCache
Set PTCache = ActiveWorkbook.PivotCaches.Create(xlExternal)
Set PTCache.RecordSet = RecordSet
Dim PT As PivotTable: Set PT = PTCache.CreatePivotTable(Worksheets("Pivot").Range("A1"), "Test")
'Cleanup
RecordSet.Close: Set RecordSet = Nothing
DataConnection.Close: Set DataConnection = Nothing
The connection doesn't close because it is referenced, indirectly, by the pivot table. Using an idiom like the one below avoids this problem:
Private Function executeQuery(sqlStatement) As ADODB.recordSet
'where conn is a global ADODB.Connection object
Set executeQuery = conn.Execute(sqlStatement, RecordsAffected:=0)
End Function
Private Sub displayResultsFor(rs As recordSet, target As Range)
writeHeader rs, target
writeBody rs, target
End Sub
Private Sub writeHeader(rs As ADODB.recordSet, target As Range)
Dim header As Range
Dim i As Integer
Set header = target
For i = 0 To rs.Fields.Count - 1
header.value = rs.Fields(i).name
Set header = header.Offset(ColumnOffset:=1)
Next i
End Sub
Private Sub writeBody(rs As ADODB.recordSet, target)
target.Offset(RowOffset:=1).CopyFromRecordset rs
End Sub
This will display the contents of the recordset and avoid the pivottable and thereby avoid the stored connection. This may or may not be what you want. The other option that you have is write a bit of code to delete the connection. The downside of that is that you will no longer be able to use
pt.RefreshTable