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
Related
I've been asked to make a change to a VB6 project. The issue I'm having is that I'm trying to get some data from an Access database and assign the data to some variables.
I've got the code:
Dta_Period.DatabaseName = DB_Accounts_Name$
Dta_Period.RecordSet = "SELECT * FROM [Period]"
Dta_Period.Refresh
The table Period contains 2 fields. sMonth and Period
The sMonth field contains the months January - December. The Period field stores a number 0 to 11, to represent what number has been assigned to which month in the customers financial year. January may be 0, or may be 11, essentially.
I need to know which month goes with which period, which is why I have selected this data from the database. However, I'm stuck with what to do next.
How can I loop over the RecordSet (If this is even possible?) and find out what number has been assigned to each month?
I don't think there is a way I can use a Do Until loop. Is it easier to just use 12 separate queries, and then create an array of strings and an array of integers and then loop over the array of strings until I find the correct month, the use the same index for the array on integers?
EDIT 1
To make things simpler to follow for both myself and anyone attempting to provide an answer, I have modified the code.
Dim rstPeriod As DAO.RecordSet
Dim accDB As DAO.Database
' DB_Session is a Workspace, whilst DB_Accounts_Name$ is the name of the DB I am using
Set accDB = DB_Session.OpenDatabase(DB_Accounts_Name$)
SQL = "SELECT * FROM [Period] ORDER BY [Period]"
Set rstPeriod = accDB.OpenRecordset(SQL, dbOpenDynaset)
If rstPeriod.BOF = False Then
rstPeriod.MoveFirst
End If
Dim strMonth(11) As String
Dim pNumber(11) As Integer
Pseudocode idea:
Do Until rstPeriod.EOF
Select Case currentRow.Field("Month")
Case "January"
strMonth(0) = "January"
pNumber(0) = currentRow.Field("Number")
Case "February"
strMonth(1) = "February"
pNumber(1) = currentRow.Field("Number")
End Select
Loop
Loop through recordset and fill the arrays with the month name and month number.
This assumes the recordset returns no more than 12 records.
Public Sub LoopThroughtRecordset()
On Error GoTo ErrorTrap
Dim rs As DAO.Recordset
Set rs = CurrentDb().OpenRecordset("SELECT * FROM [Period] ORDER BY [Period]", dbOpenSnapShot)
With rs
If .EOF Then GoTo Leave
.MoveLast
.MoveFirst
End With
Dim strMonth(11) As String
Dim pNumber(11) As Integer
Dim idx As Long
For idx = 0 To rs.RecordCount -1
strMonth(idx) = rs![Month]
pNumber(idx) = rs![Number]
rs.MoveNext
Next idx
Leave:
On Error Resume Next
rs.Close
Set rs = Nothing
On Error GoTo 0
Exit Sub
ErrorTrap:
MsgBox Err.Description, vbCritical, CurrentDb.Properties("AppTitle")
Resume Leave
End Sub
'strMonth(0) = January
'strMonth(1) = February
'...
'pNumber(0) = 1
'pNumber(1) = 2
'...
I'm having an issue with a piece of VBA I've written for Access. I have a table with a concatenation field 'Concat' (string field) and field called 'Age' (integer field with numerical values).
There are another 61 fields (named '0','1','2'...'60' respectively) where the code needs to work though: I want the code to loop through and, per record entry - for the VBA to Dlookup using the Concat + age fields to another table (called: tbl_Final_Probabilities) and pull back a probability and populate each of these 61 fields with the correct probability. These fields are set up at a numerical field, data type as Single.
The code pulls the correct probability but when I try to update the record for that field at the code line: "rs.Fields(a) = b" (also highlighted in code), I get the error message: "Run time error '3164': 'Field cannot be updated'".
All help welcome on how I need to correct this please, the code used is below.
Punch and pie.
Code:
Dim rs As DAO.Recordset
Dim a As Integer
Dim b As Single
Dim lookup As String
Set rs = CurrentDb.OpenRecordset("SELECT * FROM tbl_Circuit_plus_prob")
For a = 0 To 60
If Not (rs.EOF And rs.BOF) Then
rs.MoveFirst
Do Until rs.EOF = True
rs.Edit
lookup = rs!Concat & (rs!age + a)
b = DLookup("Prob_Date", "tbl_Final_Probabilities", "Concat2 = '" & lookup & "'")
rs.Fields(a) = b '- CODE BREAKS DOWN HERE
rs.Update
rs.MoveNext
Loop
End If
Next a
rs.Close
Set rs = Nothing
Thanks in advance for any and all help.
You loop is turned inside out:
Dim rs As DAO.Recordset
Dim a As Integer
Dim b As Single
Dim lookup As String
Set rs = CurrentDb.OpenRecordset("SELECT * FROM tbl_Circuit_plus_prob")
If Not (rs.EOF And rs.BOF) Then
rs.MoveFirst
Do Until rs.EOF = True
rs.Edit
For a = 0 To 60
lookup = rs!Concat & (rs!age + a)
b = DLookup("Prob_Date", "tbl_Final_Probabilities", "Concat2 = '" & lookup & "'")
rs.Fields(a).Value = b
Next
rs.Update
rs.MoveNext
Loop
End If
rs.Close
Set rs = Nothing
Your code: rs.Fields(a) = b addresses the field with the index 'a' (which is 0 in the first loop), in your table, this is probably an auto increment field and therefore cannot be updated. If you want to write in the fields with the names '0','1',... use this syntax: rs.Fields(x + a) = b, where x is the number of fields+1 (because your loop starts with 0) in the table existing before your field '0'.
I use a custom made import function (skeleton below) to gather data from "Linked" text files (containing header/records/footer). The first field of the header will always contains 123, but I need to skip those records where the second field in the header begins with the letters "AC".
I tried to create a loop that, when it finds first field contains "123" and the second field starts with "AC" then to skip the records until it finds another "123", then assess again through the loop and only break out of the loop to write the records that don't contain "AC" in the second field of the header.
However I get "Compile error: Augment not optional" based on line Loop Until rs!Field1 = "123" And Left(rs!Field2) <> "AC", when trying the following and not quite sure how else to go about checking if the string in the second field starts with "AC". Thanks.
Public Function FormatTextFile()
Dim db As Database
Dim rs, rsa As Recordset
Dim cCount as double
Set db = CurrentDb
Set rs = db.OpenRecordset("Flow_20160316")
cCount = 1
Do
Do While rs!Field1 = "123" And Left(rs!Field2, 2) = "AC"
Debug.Print "Code Skipped on Record " & cCount
cCount = cCOunt + 1
rs.MoveNext
Loop Until rs!Field1 = "123" And Left(rs!Field2) <> "AC"
Select Case rs!Field1
Case Is = "123"
'Code continues and writes some variables to tables'
Case else
Debug.Print "Code Skipped on Record " & cCount
End select
cCount = cCOunt + 1
rs.MoveNext
Loop until rs.eof
rs.Close
db.Close
Set rs = Nothing
Set db = Nothing
End Function
Do / While / Until loops in VBA come in a variety of forms, there is an answer here on SO (but I can't find it now) that lists 7 versions.
(Edit: found it - Warning: don't go there if you don't have some spare time to waste)
But
Do While <condition>
' stuff
Loop Until <condition>
isn't allowed - it's a syntax error. The condition can appear only once.
Here is a decent overview:
http://www.excelfunctions.net/VBA-Loops.html#DoWhileLoop
With that being said, your code with the nested loops seems overly complicated. Can't you simply do this?
Do While Not rs.EOF
If rs!Field1 = "123" And Left(rs!Field2, 2) = "AC" Then
Debug.Print "Code Skipped on Record " & cCount
Else
' regular code
End If
cCount = cCount + 1
rs.MoveNext
Loop
Note: by using Do While Not rs.EOF you avoid an error if rs is empty.
hi guys im trying to take the value of data(0)
and put it into say variable InvoiceNumber. I tried putting an image of my watch screen but i ended up not being allow. but here is what my watch screen would look like.
data
data(0)
data(0,1) 1
data(0,2) 2
data(0,3) 3
I have tried
dim InvoiceNumber as variant <br/>
invoiceNumber = data(0)
but i keep getting error. I dont know how to reference just the part of that array. any help would be greatly appreciated.
here is the full code for anyone that would like to see a little more.
Dim db As Database
Dim rs As Recordset
Dim data As Variant
Dim colummn1 As Variant
Dim obj As Object
Set db = CurrentDb
Set rs = db.OpenRecordset("select * from Table1")
'set obj = new object
While Not rs.EOF
'MsgBox (rs.RecordCount)
'MsgBox (rs.Fields.Count)
data = rs.GetRows(rs.Fields.Count)
Column1 = data.data(0)
Wend
rs.Close
db.Close
End Sub
Try
Column1 = data(0,0)
instead of
Column1 = data.data(0)
data contains a two-dimensional array. The fist index is the field number, the second index is the row number. Both start at zero. So data(0,0) is the first field of the first row. data(1,0) is the second field of the first row.
I would try to make an array of invoices by using a user defined type
Public Type Invoice
Nr As Variant
IssueDate As Variant
Total As Variant
'Or whatever your invoice contains
End Type
Public Sub TestGetRecords()
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim data As Variant
Dim numRecords As Long, i As Long
Dim Invoices() As Invoice
Set db = CurrentDb
Set rs = db.OpenRecordset("select * from Table1")
data = rs.GetRows()
rs.Close
db.Close
numRecords = UBound(data, 2) + 1
ReDim Invoices(0 To numRecords - 1) As Invoice
For i = 0 To numRecords - 1
Invoices(i).Nr = data(0, i)
Invoices(i).IssueDate = data(1, i)
Invoices(i).Total = data(2, i)
Next i
Debug.Print Invoices(0).Total
End Sub
An error in you solution is, that you placed GetRows in a loop. However, GetRows returns all the rows at once!
I am finding it a little hard to understand what you are trying to achieve.
You are reading an entire table of data into a recordset object, loading the fields of the recordset object into a two dimensional array and then trying to iterate through the array to output the results to a single variable (or a sum of array values).
Why don't you just use an SQL expression to extract the data directly from your table?
If we can assume you have a table of invoices (say ... "myInvoiceTable") with at least the following fields ...
invoiceID
invoiceValue
(and probably many others, eg. invoiceDate, clientID, etc.)
you can write an expression something like this
"SELECT SUM(invoiceValue) AS MyTotal FROM myInvoiceTable WHERE invoiceID > xxxx"
This might go into your VBA code like this.
Dim rst as Recordset
Dim strSQL as string
strSQL = "SELECT SUM(invoiceValue) AS MyTotal FROM myInvoiceTable WHERE invoiceID > 400" '-- use an appropriate WHERE clause if needed
Set rst = CurrentDb.Openrecordset(strSQL) '-- the rst object should contain a single value "MyTotal" which is the sum of the fields you are trying to access
MsgBox rst!MyTotal '-- use this value wherever you need to use it
I'm looking to iterate through a set of fields as part of a table that follow a specific format. The table contains N pairs of these fields (Var_1, Value_1, Var_2, Value_2, etc).
I need to iterate through these fields and extract the data to write it out to a text file. I'd like to use a loop, I'd rather not hardcode each field into my VBA as the fields will likely grow in time and not every field will be populated for every record. I guess if there was a way to "evaluate" a field when its name is dynamically created in a string, that would solve my problem.
So, for example...
For i = 1 to FieldCount
' Write data to each field
Initially I thought of something like this
For i=1 to FieldCount
myStr = "!Var_"+CStr(i) + " = " + "!Value_" + CStr(i)
WriteLine(myStr)
but course, it prints the text literally... any way to get Access to evaluate that text first?
Perhaps there is a better way to approach this entirely?
You can use your record set's Fields collection, and refer to the value of any individual field by referencing the field's name.
rs.Fields("field_name").Value
You can generally drop the explicit .Value since that's the field's default property.
Public Sub printFieldPairs()
Dim strSql As String
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim N As Long
strSql = "SELECT * FROM tblJoeS;"
Set db = CurrentDb
Set rs = db.OpenRecordset(strSql)
With rs
Do While Not .EOF
For N = 1 To 3
Debug.Print .Fields("Var_" & N) & " = " & _
.Fields("Value_" & N)
Next N
.MoveNext
Loop
End With
rs.Close
Set rs = Nothing
Set db = Nothing
End Sub
That's what I think you're asking for. However, if the number of field pairs grows, you will have to revise the table structure. So my inclination would be to use a different table structure.
row_identifier fKey fValue
1 Var_1 foo
1 Var_2 bar
1 Var_3 baz
2 Var_1 abcd
As suggested improvement to HansUp answer:
....
Dim fld as DAO.Field
For Each fld in rs.fields
debug.? fld.value
Next fld