The following code is meant to compare a field value PURE_QP1 of a recordset to another field value PURE_QP1 of another second set. But i am getting end of statement expected error. My knowledge of Access vba is admittedly low.
The code is meant to first check if the productcode is present in recordset rst.
if it is, then it checks if it is compliant by finding its PURE_QP1 (which coud be more than 1) in another table. the condition for compliance is such that all its QP1s must be found in the table.
Dim db As DAO.Database
Dim rst As Recordset
Dim rst1 As Recordset
If Nz(Me!Combo_Product_number) <> "" Then
Set db = CurrentDb
Set rst = db.OpenRecordset("Q_compliant_FCM_EU", dbOpenDynaset)
Set rst1 = db.OpenRecordset("T_DOSSIER_FPL", dbOpenDynaset)
Do While Not rst.EOF
If rst.Fields("PRODUCT_CODE") = Me!Combo_Product_number Then
rst1.FindFirst "[PURE_QP1] = '"rst.Fields("PURE_QP1")"'"
If rst.NoMatch Then
MsgBox ("Product code is NOT compliant to FPL")
Exit Sub
End If
rst1.FindNext"[PURE_QP1] = '"rst.Fields("PURE_QP1")"'"
Loop
MsgBox ("Product code is compliant to FPL")
Else
MsgBox ("Product is not available in FCM_EU")
End If
End If
End Sub
Expected end of staement error is showing in
rst1.FindFirst "[PURE_QP1] = '"rst.Fields("PURE_QP1")"'"
and
rst1.FindNext"[PURE_QP1] = '"rst.Fields("PURE_QP1")"'"
You have an extra End If just before End Sub. That End If should go above Loop command to close the If rst.Fields("PRODUCT_CODE") = Me!Combo_Product_number Then if block.
Also your code regarding rst1 is wrong.
rst1.FindFirst "[PURE_QP1] = '"rst.Fields("PURE_QP1")"'"
should be
rst1.FindFirst "[PURE_QP1] = '" & rst.Fields("PURE_QP1") & "'"
the & sign to join strings are missing in your code.
PS: Have no idea what your code supposed to do, because your find first and find next logic seems to be incorrect.
Related
I need a code to loop through all the records in a table so I can extract some data. In addition to this, is it also possible to loop through filtered records and, again, extract data? Thanks!
You should be able to do this with a pretty standard DAO recordset loop. You can see some examples at the following links:
http://msdn.microsoft.com/en-us/library/bb243789%28v=office.12%29.aspx
http://www.granite.ab.ca/access/email/recordsetloop.htm
My own standard loop looks something like this:
Dim rs As DAO.Recordset
Set rs = CurrentDb.OpenRecordset("SELECT * FROM Contacts")
'Check to see if the recordset actually contains rows
If Not (rs.EOF And rs.BOF) Then
rs.MoveFirst 'Unnecessary in this case, but still a good habit
Do Until rs.EOF = True
'Perform an edit
rs.Edit
rs!VendorYN = True
rs("VendorYN") = True 'The other way to refer to a field
rs.Update
'Save contact name into a variable
sContactName = rs!FirstName & " " & rs!LastName
'Move to the next record. Don't ever forget to do this.
rs.MoveNext
Loop
Else
MsgBox "There are no records in the recordset."
End If
MsgBox "Finished looping through records."
rs.Close 'Close the recordset
Set rs = Nothing 'Clean up
In "References", import DAO 3.6 object reference.
private sub showTableData
dim db as dao.database
dim rs as dao.recordset
set db = currentDb
set rs = db.OpenRecordSet("myTable") 'myTable is a MS-Access table created previously
'populate the table
rs.movelast
rs.movefirst
do while not rs.EOF
debug.print(rs!myField) 'myField is a field name in table myTable
rs.movenext 'press Ctrl+G to see debuG window beneath
loop
msgbox("End of Table")
end sub
You can interate data objects like queries and filtered tables in different ways:
Trhough query:
private sub showQueryData
dim db as dao.database
dim rs as dao.recordset
dim sqlStr as string
sqlStr = "SELECT * FROM customers as c WHERE c.country='Brazil'"
set db = currentDb
set rs = db.openRecordset(sqlStr)
rs.movefirst
do while not rs.EOF
debug.print("cust ID: " & rs!id & " cust name: " & rs!name)
rs.movenext
loop
msgbox("End of customers from Brazil")
end sub
You should also look for "Filter" property of the recordset object to filter only the desired records and then interact with them in the same way (see VB6 Help in MS-Access code window), or create a "QueryDef" object to run a query and use it as a recordset too (a little bit more tricky). Tell me if you want another aproach.
I hope I've helped.
Found a good code with comments explaining each statement.
Code found at - accessallinone
Sub DAOLooping()
On Error GoTo ErrorHandler
Dim strSQL As String
Dim rs As DAO.Recordset
strSQL = "tblTeachers"
'For the purposes of this post, we are simply going to make
'strSQL equal to tblTeachers.
'You could use a full SELECT statement such as:
'SELECT * FROM tblTeachers (this would produce the same result in fact).
'You could also add a Where clause to filter which records are returned:
'SELECT * FROM tblTeachers Where ZIPPostal = '98052'
' (this would return 5 records)
Set rs = CurrentDb.OpenRecordset(strSQL)
'This line of code instantiates the recordset object!!!
'In English, this means that we have opened up a recordset
'and can access its values using the rs variable.
With rs
If Not .BOF And Not .EOF Then
'We don’t know if the recordset has any records,
'so we use this line of code to check. If there are no records
'we won’t execute any code in the if..end if statement.
.MoveLast
.MoveFirst
'It is not necessary to move to the last record and then back
'to the first one but it is good practice to do so.
While (Not .EOF)
'With this code, we are using a while loop to loop
'through the records. If we reach the end of the recordset, .EOF
'will return true and we will exit the while loop.
Debug.Print rs.Fields("teacherID") & " " & rs.Fields("FirstName")
'prints info from fields to the immediate window
.MoveNext
'We need to ensure that we use .MoveNext,
'otherwise we will be stuck in a loop forever…
'(or at least until you press CTRL+Break)
Wend
End If
.close
'Make sure you close the recordset...
End With
ExitSub:
Set rs = Nothing
'..and set it to nothing
Exit Sub
ErrorHandler:
Resume ExitSub
End Sub
Recordsets have two important properties when looping through data, EOF (End-Of-File) and BOF (Beginning-Of-File). Recordsets are like tables and when you loop through one, you are literally moving from record to record in sequence. As you move through the records the EOF property is set to false but after you try and go past the last record, the EOF property becomes true. This works the same in reverse for the BOF property.
These properties let us know when we have reached the limits of a recordset.
I have been using a vba code to make my work life easier but for some reason it stopped working as supposed to. What it does it gets a number from my DB and goes to website to find relevant certificate assigned to this number (company), then it reads the grade and expiry date which are to be recorded in same DB. The issue is now when it goes to
rs.fields("Expiry").Value = Split(sResult, "|")(1)
it throws a Runtime error 3421 which i believe is due to column being formatted as for date data type but it worked correctly for several months..? It work when changed data type to text however that will mess it up as later I use it in queries and reports and need it as a date.
Any ideas why it changed and how to fix it please?
Thanks
MD
Sub Get_BRCDirectory_Data()
Dim sCode, rs As DAO.Recordset, dic As Object, sResult As String, i As Long
Set dic = CreateObject("Scripting.Dictionary")
dic.CompareMode = 1
Set rs = CurrentDb.OpenRecordset("Approved")
If Not (rs.BOF And rs.EOF) Then
rs.MoveFirst
Do
sCode = rs.fields("SupplierCode").Value
If sCode <> "" Then
If Not dic.Exists(sCode) Then
sResult = GetGradeExpiryDate(CStr(sCode))
rs.Edit
rs.fields("Grade").Value = Trim(Split(sResult, "|")(0))
rs.fields("Expiry").Value = Split(sResult, "|")(1)
rs.UPDATE
dic(sCode) = Array(rs.fields("Grade").Value, rs.fields("Expiry").Value)
Else
rs.Edit
rs.fields("Grade").Value = dic(sCode)(0)
rs.fields("Expiry").Value = dic(sCode)(1)
rs.UPDATE
End If
End If
rs.MoveNext
Loop Until rs.EOF
End If
MsgBox "Done", 64
I have form in which user have to enter company name, to avoid duplicates I wrote On_Exit event for data entry field. It checks all the records and if it finds duplicate it notifies user. Problem is that I use same form for entered data viewing and then doing it same On_Exit event shows duplicate warning despite entry not being duplicate. It happens because code check for all entries and since it is already in database it founds itself and raises false alarm, it is a code flaw, but I have no idea how to avoid. Can somebody offer clever way to avoid this problem without creating two identical forms (except one without duplicate checking)?
My code for duplicate checking:
Private Sub Pareisk_pav_Exit(Cancel As Integer)
Dim Par_pav As String
Dim rst As DAO.Recordset
Dim Counter As Long
Set rst = CurrentDb.OpenRecordset("tblPareiskejai")
Do Until rst.EOF
Par_pav = rst(1)
If rst(1) = Me.Pareisk_pav.Value Then
Me.WarningLB.Caption = "Entry with this name already exist"
Exit Do
Else
Me.WarningLB.Caption = ""
End If
rst.MoveNext
Loop
Exit Sub
I have tried to implement Counter in my code to ignore first match, but in this case it catches only second duplicate then entering new entry.
Counter solution (not working as intended) I have tried:
Do Until rst.EOF
Par_pav = rst(1)
If rst(1) = Me.Pareisk_pav.Value Then
Counter = Counter + 1
If Counter = 2 Then
Me.WarningLB.Caption = "Entry with this name already exist"
Exit Do
End If
Else
Me.WarningLB.Caption = ""
End If
rst.MoveNext
Loop
I suddenly come up with a solution myself. Since new entry gets new ID even before saved I thought I can use it in my advantage and added And rst(0) <> Me.ID.Value to my if clause. So far it works fine. Full edited code:
Private Sub Pareisk_pav_Exit(Cancel As Integer)
Dim Par_pav As String
Dim rst As DAO.Recordset
Dim marker As Boolean
Set rst = CurrentDb.OpenRecordset("tblPareiskejai")
Counter = 0
Do Until rst.EOF
Par_pav = rst(1)
If rst(1) = Me.Pareisk_pav.Value And rst(0) <> Me.ID.Value Then
Me.WarningLB.Caption = "Name already exist!"
Exit Do
Else
Me.WarningLB.Caption = ""
End If
rst.MoveNext
Loop
Exit Sub
End Sub
I have this table:
And I did the next query that works for sure:
SELECT tbl_Type.Id_Type,
tbl_Type.Info,
tbl_Type.Id_Table_Three_Plus_Info,
tbl_Type.DateX
FROM tbl_Type
WHERE (((tbl_Type.DateX)=[Write Date (dd/dd/yyy)]));
As you see in the query in the WHERE part there's an input of the column DateX.
Now I want to use same procedure but using a form for the input, the code to do that is this:
Private Sub btn_Action_Click()
On Error Resume Next
'DoCmd.SetWarnings False
Dim Fecha As String
Fecha = _
"SELECT tbl_Type.Id_Type, tbl_Type.Info, tbl_Type.Id_Table_Three_Plus_Info, tbl_Type.DateX FROM tbl_Type WHERE tbl_Type.DateX = txt_Date.value;"
CurrentDb.CreateQueryDef ([Nom],Fecha) As QueryDef
DoCmd.RunSQL Fecha
'DoCmd.Save Fecha, "s"
txt_Date = Null
End Sub
First, I want to know if it is well performed the input in the content of the String Fecha. As you see I'm giving that action when the button btn_Action is clicked and capturing the input for DateX with a Text Field txt_Date I would say that the query is working but I don't know how to see that, in that order I proceed to pretend to save that query, which is something desired too. I've seen in another question that for do that is used CurrentDb.CreateQueryDef I tried DoCmd.Save but I think that isn't the case. With CurrentDb.CreateQueryDef I'm having a syntax error. Am I missing something?
Please, if more details are needed, still is a silly question or things like that let me now, to do the correct procedure!
Consider simply saving a parameterized query and then in VBA bind your form value to parameter using QueryDef object. MS Access SQL maintains the PARAMETERS clause to set named placeholders. Below outputs parameterized query results to Excel workbook.
SQL (save below as a query, Ribbon > Create > Query Design > SQL View)
PARAMETERS DateParam Datetime;
SELECT t.Id_Type,
t.Info,
t.Id_Table_Three_Plus_Info,
t.DateX
FROM tbl_Type t
WHERE (((t.DateX)=[DateParam]));
VBA (calls query, bind parameters, export to new Excel workbook)
Private Sub btn_Action_Click()
On Error Goto ErrHandle
Dim xl_app As Object, xl_wb As Objcect
Dim qdef As QueryDef, rst As Recordset
' REFERENCE SAVED QUERY
Set qdef = CurrentDb.QueryDef("mySavedQuery")
' BIND PARAMETER
qdef!DateParam = txt_Date
' SET qdef TO RECORDSET
Set rst = qdef.OpenRecordset()
' EXPORT TO EXCEL
Set xl_app = CreateObject("Excel.Application")
Set xl_wb = xl_app.Workbooks.Add()
With xl_wb.Sheets(1)
' COLUMNS
For i = 1 To rst.Fields.Count
.Cells(1, i) = rst.Fields(i - 1).Name
Next i
' DATA
.Range("A2").CopyFromRecordset rst
End With
xl_app.Visible = True
txt_Date = Null
ExitHandle:
rst.Close()
Set rst = Nothing: Set qdef = Nothing
Set xl_wb = Nothing: Set xl_app = Nothing
Exit Sub
ErrHandle:
Msgbox Err.Number & " - " & Err.Description, vbCritical, "RUNTIME ERROR"
Resume ExitHandle
End Sub
You have to concatenate the value of the input to your query string like so
Fecha = _
"SELECT tbl_Type.Id_Type, tbl_Type.Info, tbl_Type.Id_Table_Three_Plus_Info, tbl_Type.DateX FROM tbl_Type WHERE tbl_Type.DateX = " & txt_Date.value & ";"
To inspect the result, you should execute in debug mode (Press F8 instead of F5 in vba).
When a particular form loads I need to grab a distinct list of locations from a table, with the eventual goal of displaying them to the user (baby steps though, I'll get to that).
The code below generates no error, but when I try to loop through the recordset returned by my query, I get an error in relation to the integer i.
Run-time error '6': Overflow
I've tested the query and it does return the results that I expect, so I believe that my handling of the Recordset object my be the issue.
what am I doing wrong here?
Private Sub Form_load()
Dim DB As DAO.Database
Set DB = CurrentDb ' Set the DB object to use
'**
' Grab a recordset containing distinct locations
'*
Dim RS As DAO.Recordset
Set RS = DB.OpenRecordset( _
"SELECT DISTINCT [Active Directory].[AD Location] FROM [Active Directory]" _
)
Dim i As Integer: i = 0
Dim locations() As String
ReDim locations(0)
'**
' Make an array of the locations to display
'*
If Not (RS.EOF And RS.BOF) Then ' Ensure that the recordset is not empty
RS.MoveFirst ' Move to the first record (unnecessary here, but good practice)
'**
' Loop through the recordset and extract the locations
'*
Do Until RS.EOF = True
locations(i) = RS![AD Location]
i = i + 1
ReDim Preserve locations(i)
Loop
Else
'**
' Tell the user that there are no records to display
'*
Call MsgBox( _
"Sorry, something went wrong and there are no locations to display." & vbCrLf & vbCrLf & _
"Please ensure that the Active Directory table is not empty.", _
vbExclamation, _
"You'd better sit down, it's not good news..." _
)
End If
RS.Close ' Close the recordset
Set RS = Nothing ' Be a hero and destroy the now defunct record set
End Sub
If I'm not missing something, you could just use GetRows:
Dim locations As Variant
RS.MoveLast
i = RS.RecordCount
RS.MoveFirst
locations = RS.GetRows(i)
Thanks to #Arvo who commented that I had forgotten to move to the next record in my do loop.
Adding RS.MoveNext to the loop fixed the problem.
Do Until RS.EOF = True
locations(i) = RS![AD Location]
i = i + 1
ReDim Preserve locations(i)
RS.MoveNext
Loop
You seem to know what you are doing so my question is probably pointless as I'm sure you have a good reason, BUT... why are you stuffing the recordset values into an Array?... Or more specifically how are you displaying the results to the user in the end?
I ask because it would seem to be much simpler to just bind your SQL statement into a control (subform, combobox, listbox etc.) rather than iterating through records like your doing. But, as I said I imagine you have your reasons for doing it that way.