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
Related
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 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
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 am trying to fill my 31 textboxes with one single recordset containing 31 days (from Jan 1st to Jan 31st).
While it's clear for me how to assign each field of the query to the relevant textbox, it's not clear at all how to assign the several values contained in one single field of the query to multiple textboxes.
As for example, this is my starting code:
Private Sub FillDates()
Dim cnn As ADODB.Connection
Dim rst As ADODB.Recordset
Set cnn = CurrentProject.Connection
Set rst = New ADODB.Recordset
ssql = "SELECT PricingDate From RoomCalendar WHERE PricingDate BETWEEN #01/01/2016# AND #31/01/2016# AND RateRoomCombinationId=17"
rst.Open ssql, cnn
Do Until rst.EOF = True
'txt1.Value = rst.Fields!PricingDate
'txt2.Value = rst.Fields!PricingDate
'txt3.Value = rst.Fields!PricingDate
rst.MoveNext
Loop
End Sub
Thank you in advance for your help
You can use:
Dim cnn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim Record As Integer
Dim Records As Integer
Set cnn = CurrentProject.Connection
Set rst = New ADODB.Recordset
ssql = "SELECT PricingDate From RoomCalendar WHERE PricingDate BETWEEN #2016/01/01# AND #2016/01/31# AND RateRoomCombinationId=17"
rst.Open ssql, CNN
rst.MoveLast
rst.MoveFirst
Records = rst.RecordCount
For Record = 1 To Records
Me("txt" & CStr(Record)).Value = rst.Fields!PricingDate.Value
rst.MoveNext
Next
End Sub
Note please, the format for the date expressions.
I managed to solve the question on my own. Final code is:
Private Function FillDates()
Dim cnn As ADODB.Connection
Dim ssql As String
Dim rst As ADODB.Recordset
Set cnn = CurrentProject.Connection
Dim i As Integer
Dim Records As Integer
ssql = "SELECT PricingDate From RoomCalendar WHERE PricingDate BETWEEN #2016/01/01# AND #2016/01/31# AND RateRoomCombinationId=17"
Set rst = New ADODB.Recordset
rst.CursorLocation = adUseClient
rst.Open ssql, cnn
Records = rst.RecordCount
For i = 1 To Records
Me("Text" & i).Value = rst.Fields!PricingDate.Value
rst.MoveNext
Next i
'' Clean up
rst.Close
Set rst = Nothing
End Function
Thanks for your help
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