I have the following vba code in an access 2007 file:
Private Sub Form_Load()
Dim a As String
Dim b As DAO.Recordset
a = " select col1 from table1 where id = 1 "
Set b = CurrentDb.OpenRecordset(a)
MsgBox (b)
b.Close
End Sub
But I am getting the following error on the MsgBox (b) line. Any idea why that's happening? The query returns a single value, which I want to display in a message box.
If you want the MsgBox to display the value contained in the first column of your recordset, you can do it this way ...
MsgBox b(0)
However, you don't really need to open a recordset to retrieve that single value. You could use a DLookup expression instead.
MsgBox DLookup("col1", "table1", "id = 1")
Like Matteo mentioned you need to pass a String or something that can be converted to a String to MsgBox. In this case you can specify the field in your select query.
Private Sub Form_Load()
Dim a As String
Dim b As DAO.Recordset
a = " select col1 from table1 where id = 1 "
Set b = CurrentDb.OpenRecordset(a)
MsgBox b.Fields("col1") ' Msgbox b("col1") should also work
b.Close
End Sub
Related
I have a SQL VBA query for updating values in several textboxes on a form on the click of a button.
The query takes the input from the multiple label name captions on the form. So caption of Label1 will be input for TextBox1, Label2 caption for Textbox2 etc.
I am trying to pass the label name through a variable to the query. However the following error is returned on the line where value of variable b is generated:
"Microsoft Access can't find the field '&labelname&'referred to in your expression.
My code is below. I want to use a variable so that later I can make it a function to accept the label name and return the recordset value. In this way I will be able to avoid approx. 150 lines of code as I have to update 20 to 25 textboxes with the input from same number of labels.
Private Sub Command111_Click()
Dim dbs As DAO.Database
Dim rs As DAO.Recordset
Dim ssql As String
Dim labelname As String
Dim b As String
Set dbs = CurrentDb
'--------------------------------------------------------------------------- ----
labelname = "Label24"
b = [Forms]![Bal_Sheet]![& labelname &].Caption
ssql = "select sum(a.[Bal Fwd]) from Trial_Balance a,Act_Master b where a.GBOBJ = b.object and a.GBSUB = b.sub and b.Cat = " & "'" & b & "'"
Debug.Print ssql
Set rs = dbs.OpenRecordset(ssql, dbOpenDynaset)
[Forms]![Bal_Sheet]![Text1].Value = rs(0)
'-------------------------------------------------------------------------------
rs.Close
Set rs = Nothing
dbs.Close
End Sub
Your expression:
b = [Forms]![Bal_Sheet]![& labelname &].Caption
Is not concatenating a string, as [Forms] and [Bal_Sheet] refer to objects.
Instead, you should use:
b = Forms("Bal_Sheet").Controls(labelname).Caption
I am trying to use this code to pick comma seperated numbers from ExcUID text box of form and then feed them into tblExcIndivList table.
However what I am trying to do it to split ex: 123,1213 into lines and put them in seperate rows of UID column of tblExcIndivList table but it gets saved as 1231213 in the same cell.
Sub Upd_UID()
Dim var As Variant
Dim i As Long
var = Split(Forms.Agen_Report.ExcUID.Value, vbNewLine)
CurrentDb.Execute "DELETE * FROM tblExcIndivList;", dbFailOnError
For i = 0 To UBound(var)
CurrentDb.Execute Replace("INSERT INTO tblExcIndivList ( UID ) VALUES ( '#V' );", "#V", var(i)), dbFailOnError
Next i
End Sub
Please help.
You are not splitting correctly your string, you say it is comma-separated (i.e. 123,1213) and try to split it with vbNewLine. You should specify the comma as separator:
var = Split(Forms.Agen_Report.ExcUID.Value, ",")
This will get you past this error and split correctly the input. However I cant make sure whether your query is well-formed.
I think you need something like this.
Option Explicit
Dim aCell As Range
Private Sub UserForm_Initialize()
'~~> Change Sheet1 to the relevant sheet name
'~~> Change A1:E1 to the relevant range
For Each aCell In ThisWorkbook.Sheets("Sheet1").Range("A1:E1")
If InStr(1, aCell.Value, ",") Then _
ComboBox1.AddItem Split(aCell.Value, ",")(0)
Next aCell
'~~> Remove duplicates
RemoveDuplicates ComboBox1
End Sub
Private Sub ComboBox1_Click()
Dim tmpStr As String
ComboBox2.Clear
For Each aCell In ThisWorkbook.Sheets("Sheet1").Range("A1:E1")
If InStr(1, aCell.Value, ",") Then _
tmpStr = Split(aCell.Value, ",")(0)
If Trim(ComboBox1.Value) = Trim(tmpStr) Then _
ComboBox2.AddItem aCell.Value
Next aCell
End Sub
'~~> Procedure to remove duplicates
Private Sub RemoveDuplicates(cmb As ComboBox)
Dim a As Integer, b As Integer, c As Integer
a = cmb.ListCount - 1
Do While a >= 0
For b = a - 1 To 0 Step -1
If cmb.List(b) = cmb.List(a) Then
cmb.RemoveItem b
a = a - 1
End If
Next b
a = a - 1
Loop
End Sub
Dim lastcomp As String
Dim qty As Integer
Dim rs As New ADODB.Recordset
rs.Open "select Prem1Item,Prem1Qty from [TU FAR Before VB] order by Prem1Item", accCon
Do While Not rs.EOF
If Not IsNull(rs(0).Value) Then
If rs(0).Value <> "n/a" Then
If rs(0).Value <> "" Then
premlist.AddItem rs(0).Value & Format(rs(1).Value, "00")
End If
End If
End If
rs.MoveNext
Loop
rs.Close
Dim i As Integer
Dim j As Integer
i = 1
For i = 1 To premlist.ListCount
For j = 1 To finallist.ListCount
**If Not finallist(j) = premlist(i) Or finallist(j) = "" Then**
finallist.AddItem premlist(i)
End If
Next j
Next i
AccessConnection ("Close")
End If
I am trying to take the records and pull all of the items in Prem1Item and condense then down to not show duplicates and also get the amount from Prem1Qty and show the total of each item it finds. I was trying to put them in these listboxs and then export them to a table that has 2 columns (Premium and Sum)
I am getting error 13 Type mismatch highlighting the area I have put in Bold ("If Not finalist(j) = premlist(i) Or finalist(j) = "" Then"). My plans were to get that list populated and then fill the table to generate my report with.
A list box object does not allow you to retrieve row values with an index value, like you would for an array, or a VBA Collection, or a recordset Fields collection, and so on.
There is probably a better way to say that, but I don't know how. But attempts such as the following will throw that "Type Mismatch" error ...
Debug.Print Me.finallist(1)
Debug.Print TypeName(Me.finallist(1))
If you want to retrieve the bound column value from each of the list box's rows, use the ItemData property.
Dim i As Long
For i = 0 To (Me.finallist.ListCount - 1)
Debug.Print Me.finallist.ItemData(i)
Next
Debug.Print "done"
I think you should try adding the .value to your comparrison e.g.
finallist(j).value = premlist(i).value
When there is only one record, this expression gives correct calculation, but when there are more than one record the values of last record calculated is reflected in all Total_Time (unbound text box).I have given on load and on open code of the report. Please help me.
Private Sub Report_Load()
strSQL = "SELECT * FROM [q_1ltduty]"
Set db = CurrentDb
Set rs = db.OpenRecordset(strSQL)
rs.MoveFirst
Do While Not rs.EOF
'Assigning values of fields to varia
strtime1 = Op_Time
strtime2 = Cl_Time
'This is a simple expression my code has some more detailed calculations
strhrs = strtime2 - strtime1
strtotalhrs = strhrs
'Printing the variable in Total_Time textbox(unbound)
Me.Total_Time.Value = strtotalhrs
rs.MoveNext
Loop
rs.Close
db.Close
Set db = Nothing
Set rs = Nothing
End Sub
Private Sub Report_Open(Cancel As Integer)
strSQL = "SELECT * FROM [q_1ltduty]"
Me.RecordSource = strSQL
Debug.Print strSQL
Exit Sub
ErrHandler:
MsgBox Err.Description
End Sub
Your variable strtotalhrs contains only the value of strhrs for one record, so each time you go through the loop, the value for the current record erases the value for the previous record. What you should do instead of erasing the value is adding to it.
Before the loop (if it has not already been done):
strtotalhrs = 0
then in the loop, instead of strtotalhrs = strhrs:
strtotalhrs = strtotalhrs + strhrs
and that should give you the sum total instead of the last value.
Using VBA, how can I search for a text string, for example "CHIR", in a table called "ServiceYES", in the field "Service".
After that, I would like to save the neighboring field for all the rows that "CHIR" exists in the table "ServicesYES". The "ServiceYES" table is below:
I basically, want to find all the "CHIR" in "Service" column and then save the names which are on the left of the CHIR, eg "FRANKL_L", "SANTIA_D" as an array.
Thanks for all your help in advance.
Start by creating a SELECT query.
SELECT Code_Perso
FROM ServicesYES
WHERE Service = 'CHIR';
Use SELECT DISTINCT Code_Perso if you want only the unique values.
Add ORDER BY Code_Perso if you care to have them sorted alphabetically.
Once you have a satisfactory query, open a DAO recordset based on that query, and loop through the Code_Perso values it returns.
You don't need to load them directly into your final array. It might be easier to add them to a comma-separated string. Afterward you can use the Split() function (assuming you have Access version >= 2000) to create your array.
Here's sample code to get you started. It's mostly standard boiler-plate, but it might actually work ... once you give it "yourquery".
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strItems As String
Dim varItems As Variant
Set db = CurrentDb
Set rs = db.OpenRecordset("yourquery", dbOpenSnapshot)
With rs
Do While Not .EOF
strItems = strItems & "," & !Code_Perso
.MoveNext
Loop
.Close
End With
If Len(strItems) > 0 Then
' discard leading comma '
strItems = Mid(strItems, 2)
varItems = Split(strItems, ",")
Else
MsgBox "Oops. No matching rows found."
End If
Set rs = Nothing
Set db = Nothing
I tested this and it seems to work. This function will pull all records where ServiceYes='CHIR' and dump the Code_Person value into an array which it will return:
Function x() As String()
Dim rst As Recordset
Set rst = CurrentDb.OpenRecordset( _
"Select * from ServiceYES where Service='CHIR'")
Dim Arr() As String
Dim i As Integer
While rst.EOF = False
ReDim Preserve Arr(i)
Arr(i) = rst.Fields("Code_Person")
i = i + 1
rst.MoveNext
Wend
x = Arr
End Function
Sample Usage:
Debug.Print x()(0)
Paolo,
Here is something I threw together in a few minutes. You can add it to the VBA editor in a module. It uses a trick to get the RecordCount property to behave properly. As for returing the array, you can update the function and create a calling routine. If you need that bit of code, just post a comment.
Thanks!
Option Compare Database
Function QueryServiceYES()
Dim db As Database
Dim saveItems() As String
Set db = CurrentDb
Dim rs As DAO.Recordset
Set rs = db.OpenRecordset("SELECT Code_Perso, Service, Favorites " & _
"FROM ServiceYES " & _
"WHERE Service = 'CHIR'")
'bug in recordset, MoveFirst, then MoveLast forces correct invalid "RecordCount"
rs.MoveLast
rs.MoveFirst
ReDim Preserve saveItems(rs.RecordCount) As String
For i = 0 To rs.RecordCount - 1
saveItems(i) = rs.Fields("Code_Perso")
rs.MoveNext
Next i
'print them out
For i = 0 To UBound(saveItems) - 1
Debug.Print saveItems(i)
Next i
rs.Close
Set rs = Nothing
db.Close
Set db = Nothing
End Function