I am trying to populate a form with records from a query. With this code it populates the last record only. The query is joining lots of tables and it not updateable. (I left out the query as it is long and not the issue) I want to load the records into the form and allow the user to update.
Private Sub Form_Load()
Dim strSQL As String
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim siteno As String
Set dbs = CurrentDb
strsql = "query that works"
Set rst = dbs.OpenRecordset(strSQL, dbOpenDynaset)
siteno = "ABCD"
With rst
Do While Not rst.EOF
On Error Resume Next
Me.SITE_NO = rst.Fields("SITE_NO")
rst.MoveNext
Loop
End With
Set rst = Nothing
Set dbs= Nothing
End Sub
Related
I am importing similar tables into a MS Access database to combine them into a larger data set. The first row of most of the columns are date fields. During import when the first row becomes field names, some of these dates stay dates "January-2018" and some of them become numbers "44001". I am writing a code to reference any numbers that are store as the field names and turn them into date values (ex. 44001 to January-2018).
Private Sub Command0_Click()
Dim db As DAO.Database
Dim tdf As DAO.TableDef
Dim fld As DAO.Field
Dim rs As DAO.Recordset
Dim CurrentHead As String
Dim UpdateHead As String
Set db = CurrentDb
Set tdf = db.TableDefs("PL_1")
Set rs = db.OpenRecordset("TableUpdates")
rs.MoveFirst
Do While Not rs.EOF
For Each fld In tdf
If fld.Name = CurrentHead Then
fld.Name = UpdateHead
End If
rs.MoveNext
Loop
db.Close
Set db = Nothing
Set fld = Nothing
Set tdf = Nothing
MsgBox "Changed"
End Sub
I tried using SQL but with no success. I then tried DAO, the other fields
seems to work but the column which holds attachments fails. Has someone done this before?
Private Sub copyfromtblA_Click()
Dim db As Database
Dim rs1 As DAO.Recordset
Dim rs2 As DAO.Recordset
Dim rs3 As DAO.Recordset2
'Set db = CurrentDb()
Set rs1 = db.OpenRecordset("tblA")
Set rs2 = db.OpenRecordset("tblB")
With rs2
rs2.AddNew
rs2.Fields("ItemNo").Value = Me.ItemNo.Value
rs2.Fields("Quantity").Value = Me.Quantity.Value
rs2.Fields("itemName").Value = Me.itemName.Value
'This is were I get the error since this field contains images as attachments
rs2.Fields("ItemImage").Value = Me.itemImage.Value
rs2.Update
rs1.MoveNext
End With
rs2.Close
Form.Requery
Set rs2 = Nothing
rs1.Close
Set rs1 = Nothing
End Sub
Something like this:
Private Sub copyfromtblA_Click()
Dim db As Database
Dim rs1 As DAO.Recordset
Dim rs2 As DAO.Recordset
Dim rsAtt1 As DAO.Recordset2
Dim rsAtt2 As DAO.Recordset2
Set db = CurrentDb()
Set rs2 = db.OpenRecordset("tblB")
With Me.Recordset
rs2.AddNew
rs2.Fields("ItemNo").Value = !ItemNo.Value
rs2.Fields("Quantity").Value = !Quantity.Value
rs2.Fields("itemName").Value = !itemName.Value
Set rsAtt1 = !ItemImage.Value
Set rsAtt2 = rs2!ItemImage.Value
With rsAtt1
Do While Not .EOF
rsAtt2.AddNew
rsAtt2.Fields("FileData") = .Fields("FileData")
rsAtt2.Fields("FileName") = .Fields("FileName")
rsAtt2.Update
.MoveNext
Loop
End With
rs2.Update
End With
rs2.Close
Set rs2 = Nothing
rsAtt1.Close
Set rsAtt1 = Nothing
'I was getting an error here! removing the "rsAtt2.Close" solved the problem
'rsAtt2.Close
Set rsAtt2 = Nothing
End Sub
I'm trying to write This Programm:
Function funktion()
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim rt As DAO.Recordset
Set db = CurrentDb
Set rs = db.OpenRecordset("All")
Do While Not rs.EOF
Set rk = db.OpenRecordset("Archive")
'here I want to copy(append) the current index(of Table"All") into the next free
index (of table "archive")
Do something
rs.MoveNext
Loop
my programm works well just I need to append the current row from "All" into the next free row from table "Archive".
Thank you for your help
here´s a example of how you can do this using ADO and not DAO to access data.... in example above.. i add all records to another table... but easily you can just add the current record in your loop...
Dim cnn As New ADODB.Connection
Dim rs As ADODB.Recordset
Dim rs2 As ADODB.Recordset
Set cnn = CurrentProject.Connection
Set rs = New ADODB.Recordset
Set rs2 = New ADODB.Recordset
'open main recordset (TDetPed)
rs.Open "SELECT TDetPed.* FROM TDetPed WHERE CodPed = " & CodPed & "", cnn, adOpenKeyset, adLockOptimistic
'open clone table recordset (TDetPedTemp)
rs2.Open "TDetPedTemp", cnn, adOpenKeyset, adLockOptimistic
'move to first record of main table
rs.MoveFirst
'add record by record in clone table(rs2) from maintable(rs)
Do Until rs.EOF
rs2.AddNew
rs2("CodPed") = rs("CodPed")
rs2("CodDetPed") = rs("CodDetPed")
rs2("CodInterno") = rs("CodInterno")
rs2("DescrDetPed") = rs("DescrDetPed")
rs2("DescontoDetPed") = rs("DescontoDetPed")
rs2("CodProd") = rs("CodProd")
rs2("PreçoDetPed") = rs("PreçoDetPed")
rs2("QtdeDetPed") = rs("QtdeDetPed")
'update current added record in clone table
rs2.Update
'move to next record in main table
rs.MoveNext
'Move para o proximo registro do detalhe do pedido
Loop
'close everthing
rs.Close
rs2.Close
cnn.Close
'clean everthing
Set rs = Nothing
Set rs2 = Nothing
Set cnn = Nothing
Just completing the answer... a simple example using DAO (Data Access Objetcs) and not ADO(Active Data Objetcs). (more info https://msdn.microsoft.com/en-us/library/aa261340%28v=vs.60%29.aspx / http://www.utteraccess.com/wiki/index.php/Choosing_between_DAO_and_ADO)
Dim db As DAO.Database
Dim rs As DAO.Recordset
Set db = CurrentDb
Set rs = dbsNorthwind.OpenRecordset("Tbl1")
rs.AddNew
rs!Cidade = "Curitiba"
rs!Country = "Brazil"
'.... others fields
rs.Update
Private Sub Command22_Click()
' This section deals with grabbing the 3 calculations from qry_LiveOEE
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Set dbs = CurrentDb
'Open a dynaset-type Recordset using a saved query
Set rst = dbs.OpenRecordset("qry_LiveOEE", dbOpenDynaset)
rst.MoveFirst
numfg_posted = rst!SumOfqty_complete
numOEE = rst!OEE
numpp_lhr = rst!ACT_PPLHR
rst.Close
dbs.Close
Set rst = Nothing
Set dbs = Nothing
I get an error saying Too few parameters. Expected 4. This query has 5 things in the criteria section (design view), so why is it saying I need 4 parameters?
The 5 things in the criteria section (all under different fields) are:
input from a form
input from a form
Switch statement based on current time
Date()
Is Not Null
Try this (not tested) update to the code:
Private Sub Command22_Click()
' This section deals with grabbing the 3 calculations from qry_LiveOEE
Dim dbs As DAO.Database
Dim rst As DAO.Recordset
Dim qdf AS DAO.QueryDef
Dim prm As DAO.Parameter
Set dbs = CurrentDb
Set qdf = dbs.QueryDefs("qry_LiveOEE")
For Each prm In qdf.Parameters
prm.Value = Eval(prm.Name)
Next prm
Set rst = qdf.OpenRecordset
rst.MoveFirst
numfg_posted = rst!SumOfqty_complete
numOEE = rst!OEE
numpp_lhr = rst!ACT_PPLHR
rst.Close
dbs.Close
Set rst = Nothing
Set dbs = Nothing
Make sure all the values in the parameters are available - i.e. the form is open.
I have a module with a procedure inside that looks like this:
Public Sub OpenRecordset()
Dim qdf As QueryDef
Set qdf = CurrentDb.QueryDefs("QOff2")
qdf.Parameters(0).Value = [Forms]![Form]![Text10]
Dim db As Database
Dim rs As Recordset
Dim StrBusinesses As String
Set rs = qdf.OpenRecordset
If rs.EOF And rs.BOF Then
MsgBox ("No businesses exist for this Customer")
Exit Sub
Else
rs.MoveFirst
End If
StrBusinesses = ""
Do While Not rs.EOF
StrBusinesses = StrBusinesses & rs!Fnam & ", "
rs.MoveNext
Loop
rs.Close
StrBusinesses = Left(StrBusinesses, Len(StrBusinesses) - 2)
Forms!Form.Badge = StrBusinesses
Set rs = Nothing
End Sub
I am trying to get this module to input the query results into a textbox (forms!form.badge), but I can't seem to get it to do it like my 5 other dlookup functions. When I open up the module and push the green play button, it shows up on the correct textbox but also shows up on the other records as well. It also doesn't show up automatically, nor does it update as you enter in the parameters. Isn't a module supposed to help autofil numerous variables into a text box in place of dlookup for multiple values?
No. If Forms!Form!Badge is an unbound textbox, a value assigned to it will be shown identically for all records.
To individualize, you will need a lookup function which takes the ID or other unique value of the record as parameter(add to textbox):
=LookupBadges([Forms]![Form]![Text10])
Public Function LookupBadges(ByVal Value As Variant) As Variant
Dim db As Database
Dim qd As QueryDef
Dim rs As Recordset
Dim Businesses As String
Set db = CurrentDb
Set qd = db.QueryDefs("QOff2")
qd.Parameters(0).Value = Nz(Value)
Set rs = qd.OpenRecordset
If rs.RecordCount > 0 Then
rs.MoveFirst
Do While Not rs.EOF
Businesses = Businesses & rs!Fnam.Value & ", "
rs.MoveNext
Loop
End If
rs.Close
Businesses = Left(Businesses, Len(Businesses) - 2)
LookupBadges = Businesses
Set rs = Nothing
Set qd = Nothing
Set db = Nothing
End Function