Print selected value from SQL to textbox VB6 - sql

I am trying to print the selected value from a query in VB6 this is my code
dim query as string
dim stsstring as string
dim rs as adobd.recordset
query = "select status from x where y='"& randomString &"'"
set rs = mainmodule.dbutils.dbconnection.connection.execute(query)
set rs = nothing
stsstring = rs.fields("status")
msgbox stsstring
I get error here
stsstring = rs.fields("status")
Object variable or with block variable not set
Thanks in advance!

You've set rs to nothing before trying to read the status field from it. Re-order your code to read:
'...
stsstring = rs.fields("status")
set rs = nothing
msgbox stsstring

Both of the below work, but to be completely on the safe side:
set rs = mainmodule.dbutils.dbconnection.connection.execute(query)
if not (rs.BOF And rs.EOF) then
rs.MoveFirst
Do While Not rs.EOF
If Not IsNull(rs("status").value)
stsstring = rs("status").value
Debug.Print stsstring
Else
Debug.Print "Column 'status' is NULL."
End If
rs.MoveNext
Loop
end if
If Not rs Is Nothing Then
If rs.State > adStateClosed Then
Call rs.Close()
End If
Set rs = Nothing
End If
An easy way to circumvent the If Not IsNull() condition for strings is to use stsstring = vbNullString & rs("status").value

Related

Deleting from recordset

I have a sub that deletes the records in recordset2 based on the records of recordset1.
The function works but very slow. Recordset1 has 300 records, Recordset2 73000 records.
Is there any way to speed this up?
Is it possible to use a filter, or a refiltered recordset?
Public Sub Erase()
DoCmd.SetWarnings False
Dim db As DAO.Database
Dim rs1 As DAO.Recordset
Dim rs2 As DAO.Recordset
Set db = CurrentDb()
Set rs1 = db.OpenRecordset("Tbl_1", dbOpenTable)2
Set rs2 = db.OpenRecordset("KISS_2", dbOpenDynaset)2
If rs1.RecordCount > 0 Then
rs1.MoveLast
rs1.MoveFirst
lngCountRecordsRs1 = rs1.RecordCount
Do Until rs1.EOF
rs2.MoveFirst
Do Until rs2.EOF
If rs1!ID = rs2!ID Then
With rs2
.Delete
End With
End If
rs2.MoveNext
Loop
rs1.MoveNext
Loop
End If
rs2.Close
rs1.Close
Set rs2 = Nothing
Set rs1 = Nothing
Set db = Nothing
Errorhandler:
End Sub
Eventually I solved the problem with .FindFirst.
Thanks for the input!
With rs2
.FindFirst "Id = " & rs1![ID]
If rs2.NoMatch Then
Else
.Delete
Exit Do
End If
End With

how close the first recordset to get another value form cbox

I have this code, i get some values from a list, is okey, and I want to get another value from cbox, I've tried to close the recordset but, I have an error:
Private Sub cmdAƱadir_Click()
Dim VARITEM
Dim RS As DAO.Recordset
Set RS = CurrentDb.OpenRecordset("SELECT TipoProducto, Descripcion, Proveedor, RefSap, RefProveedor FROM tblCarrito")
For Each VARITEM In Me.Lista0.ItemsSelected
RS.AddNew
RS!TipoProducto = Me.Lista0.Column(1, VARITEM)
RS!Descripcion = Me.Lista0.Column(2, VARITEM)
RS!Proveedor = Me.Lista0.Column(3, VARITEM)
RS!RefSap = Me.Lista0.Column(4, VARITEM)
RS!RefProveedor = Me.Lista0.Column(7, VARITEM)
RS.Update
RS.Close
Next
Dim rst As Recordset
Set rst = CurrentDb.OpenRecordset("tblCarrito")
With rst
.AddNew
.Fields("destino") = Cuadro_combinado70.Value
.Update
End With
End Sub
the problem is solved, I use the bucle for each to catch the values of cbox and the values of list.
thank you for your attention

MS Access VBA to update a Combobox table field

I have a table with a field with the display control set to Combo Box and I have not been able to read or write to it using an OpenRecordSet. What would I have to do to modify to get these scenarios to work?
Sub TryToRead()
Set db = CurrentDb
Set rs = db.OpenRecordset("tbl", dbOpenDynaset)
x = rs!FieldName '<------Combo Box Field. x shows no info.
End Sub
Sub TryToWrite()
Set db = CurrentDb
Set rs = db.OpenRecordset("tbl", dbOpenDynaset)
With rs
.AddNew
rs!FieldName = "Test Value" '<------ Results in Run-time error 64224 Application-defined or object-defined error
.Update
End With
End Sub
I think I have what I need.
Sub Testing()
Set db = CurrentDb
Set rs = db.OpenRecordset("tbl", dbOpenDynaset)
MyStr = Array("Value1", "Value2")
Do Until rs.EOF = True
Set rs2 = rs!FieldName!Value
rs.Edit
For Each c In MyStr
rs2.AddNew
rs2!Value.Value = c
rs2.Update
Next c
rs.Update
rs.MoveNext
Loop
End Sub

The checking is always true after first loop in VBA in Access

The "Check" somehow is always 0 after first loop, I keep debugging but still cannot find out why. Any idea? The data suppose to make "check" be 0 sometimes but not all the time.
Private Sub Command12_Click()
Dim db As Database
Dim rs As DAO.Recordset
Dim rs2 As DAO.Recordset
Set db = CurrentDb()
Set rs = db.OpenRecordset("Amity")
Set rs2 = db.OpenRecordset("Opportunity")
Set rs3 = db.OpenRecordset("SalesForceDonor")
Set rs4 = db.OpenRecordset("Donor")
While Not rs.EOF
check = 0
While Not rs3.EOF
If rs("Donor_Code") = rs3("Donor_Code") Then
check = 1
End If
rs3.MoveNext
Wend
If check = 0 Then
rs4.AddNew
rs4![Donor_Code] = rs![Donor_Code]
rs4.Update
End If
rs2.AddNew
rs2![Donor_Code] = rs![Donor_Code]
rs2![Donation_name] = rs![Donation_name]
rs2.Update
rs.MoveNext
Wend
rs3.Close
rs4.Close
rs2.Close
rs.Close
End Sub
I've found somethig that must be corrected, adding rs3.MoveFirst for each record of rs:
Private Sub Command12_Click()
Dim check
Dim db As Database
Dim rs As DAO.Recordset
Dim rs2 As DAO.Recordset
Set db = CurrentDb()
Set rs = db.OpenRecordset("Amity")
Set rs2 = db.OpenRecordset("Opportunity")
Set rs3 = db.OpenRecordset("SalesForceDonor")
Set rs4 = db.OpenRecordset("Donor")
While Not rs.EOF
check = 0
rs3.MoveFirst ' <= here we move to the first record of rs3!!!
Do While Not rs3.EOF
If rs("Donor_Code") = rs3("Donor_Code") Then
check = 1
Exit Do
End If
rs3.MoveNext
Loop
If check = 0 Then
rs4.AddNew
rs4![Donor_Code] = rs![Donor_Code]
rs4.Update
End If
rs2.AddNew
rs2![Donor_Code] = rs![Donor_Code]
rs2![Donation_name] = rs![Donation_name]
rs2.Update
rs.MoveNext
Wend
rs3.Close
rs4.Close
rs2.Close
rs.Close
End Sub

Get Excel VBA MS Access query to append or display array queried?

I'm trying to query a MS Access (2007-2010) database using Excel and print the query to my spreadsheet.
The below code prints only the field header into a specified cell and none of the other data in the selected field. Where am I going wrong? hints etc welcome.
Option Explicit
' Add reference to Microsoft ActiveX Data Objects Lib
Public Sub main(): On Error GoTo Err_handler
Dim cn As ADODB.Connection
Set cn = New ADODB.Connection
'open DB connection
cn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=Databaselocation
cn.Open
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
'Query Stuff
rs.ActiveConnection = cn
rs.Open "SQL Query here;"
'does something
Dim fld As ADODB.Field
Dim rng As Range
Set rng = [a2]
For Each fld In rs.Fields
rng.Value = fld.Name
Set rng = rng.Offset(0, 2)
Next fld
Set rng = rng.Offset(2, -rs.Fields.Count)
rng.CopyFromRecordset rs
' closes db connection
rs.Close
cn.Close
Set rs = Nothing
Set cn = Nothing
Exit Sub
Err_handler:
MsgBox Err.Description
End Sub
You want to skip over one column at a time when displaying column names, not two, because the rng.CopyFromRecordset method will output the recordset with no gaps.
Set rng = rng.Offset(0, 1)
I tested your code and it does work with that change.
You must loop also in Rows in your rs (ADODB.Recordset) object. Use MoveNext method to move to next row.