I have two txt boxes and two combo boxes on a form. There is also a subform linked to the temptable that I want to have rebuilt/filter each time one of the controls is changed (using after update on each control to trigger the following sub)
I receive Run-time error '91: Object variable or with block variable not set on line Items(i) = Thing
I am not sure using " (i) " works with MS Access 365 or I am dimensioning incorrectly?
Thank you.
Private Sub Lookupstuff()
Dim i As Integer
Dim Items(1 To 4) As Object
sql = "DELETE * FROM tblTemp"
CurrentDb.Execute sql
i = 0
FilterArray = Array(Me.txtNew, Me.cmbS, Me.cmbP, Me.txtSl)
For Each Thing In FilterArray
If Not IsNull(Thing) Then
i = i + 1
Items(i) = Thing <--Error is here. Items(i) is empty.
End If
Next
If i = 0 Then
Forms!frmNew.Requery
Forms!frmNew.Refresh
End If
If i = 1 Then
Filter = Items1
End If
If i = 2 Then
Filter = Items1 & " AND " & Items2
End If
If i = 3 Then
Filter = Items1 & " AND " & Items2 & " AND " & Items3
End If
If i = 4 Then
Filter = Items1 & " AND " & Items2 & " AND " & Items3 & " AND " & Items4
End If
sql = "INSERT INTO tblTemp SELECT * FROM tblQ"
If Not IsNull(Filter) Then
sql = sql & " WHERE " & Filter
End If
CurrentDb.Execute sql
Forms!frmNew.Requery
Forms!frmNew.Refresh
End Sub
Since you are assigning a reference to object in the array, you must use Set, i.e.:
Set Items(i) = Thing
Also, presumably each reference to Items1, Items2 etc. should actually be Items(1), Items(2) in order to access the objects referenced at these indices of the array.
Related
I have a form contains of 3 listboxes that will filter my report based on the selected items
in my query I used the below criteria for the combobox and I tried it on the listbox but it does not work!
Like [Forms]![Statusfrm]![FieldCombo] & "*"
any advise please?
I also tried this but when I select one selection it is not showing records for the same selection!
Private Sub Command26_Click()
On Error GoTo ControlError
Set ctl = Me.Combo22 'frm!Combo22
Set ctl2 = Me.Combo24
'Set rpt = Foms!rpt
If Me.Combo22.ListIndex <> -1 Then 'And Me.Combo24.ListIndex <> -1
miFiltro = "id in("
For Each varItm In ctl.ItemsSelected
'miFiltro = miFiltro & "'" & varItm & "',"
miFiltro = miFiltro & varItm & ","
'Lista27.AddItem varItm
'ctl.ItemData (varItm)
Next varItm
miFiltro = Mid(miFiltro, 1, Len(miFiltro) - 1)
miFiltro = miFiltro & ")"
'MsgBox (miFiltro)
If miFiltro <> "" Then
DoCmd.OpenReport "Rpt", acViewPreview, , miFiltro
miFiltro = ""
End If
'Aplicamos el filtro al formulario
'Me.Filter = miFiltro
'Me.FilterOn = True
Else
MsgBox ("Please select data")
Me.Combo22.SetFocus
End If
'DoCmd.OpenReport "Rpt", acPreview, , Me.Filter
ControlError:
MsgBox "Encontré el error" & Err.number & " " & Err.Description
End Sub
You can change your Report to be based on a fixed DB query. When the user clicks the "View Report" button, add the code:
Dim strSQL As String
strSQL = "SELECT * FROM YourTable WHERE [Place] = '" + Me!Statusfrm + "'"
CurrentDB.QueryDefs("TheAccessQueryObjectTheReportIsBasedOn").SQL = strSQL
DoCmd.OpenReport "YourReport"
In this model, you are setting the SQL of the Query object at the Access DB container level, then opening the report. You can debug your VBA code more easily this way, instead of relying on a RecordSource query with a runtime parameter referencing the form. You can also close the form if you want to before opening the report.
The WHERE condition for your strSQL variable can be built up based on input (or lack thereof) from the user. For example:
If Nz(First(Me!categoryListBox.SelectedItems).Value,"") <> "" Then
strSQL = strSQL + " AND [Category] = '" Me!categoryListBox.SelectedItems).Value + "'"
End
If Nz(First(Me!placeListBox.SelectedItems).Value,"") <> "" Then
strSQL = strSQL + " AND [Place] = '" Me!placeListBox.SelectedItems).Value + "'"
End
Also, is your list box bound to an ID or the text of the item selected? You may be getting an ID vs the text you are trying to use with the asterisk wildcard. A list box can have multiple selections, so you need to disable it, or do something like :
strSQL = "SELECT * FROM YourTable WHERE [Place] = '" + First(Me!statusfrm.SelectedItems).Value + "'"
If the user can only select one value, a combobox it the better choice. Either way, by building up an SQL statement in VBA that uses the forms value, you can debug the syntax of the SQL more easily.
Based on a user's job ID number, I create a recordset of an ID with its different unit types (think pipe sizes) and unit (think footage of pipe). Each unit type record already has the name of the form textbox where the total footage goes in a different column. What I want to do is go through each recordset and plugin the footage for each unit type for that job ID number (that the user puts in a form).
Dim rst_UnitEntryCounts As Recordset
Set rst_UnitEntryCounts = CurrentDb.OpenRecordset("SELECT tbl_UnitTypes.UnitTypes_WeeklyTextBoxUserEntryForm, " _
& " tbl_PMEntry.PMEntry_Week_Ending, " _
& " tbl_UnitTypes.UnitTypes_CumalativeTextBoxUserEntryForm, " _
& " Sum(tbl_UnitEntry.UnitEntry_Unit_Count) AS SumOfUnitEntry_Unit_Count " _
& "FROM tbl_UnitTypes " _
& " INNER JOIN tbl_UnitEntry ON tbl_UnitTypes.UnitTypes_ID = tbl_UnitEntry.UnitEntry_UnitTypes_ID) " _
& " INNER JOIN (tbl_PMHeader " _
& " INNER JOIN tbl_PMEntry ON tbl_PMHeader.PMHeader_ID = tbl_PMEntry.PMEntry_PMHeader_ID) ON tbl_UnitEntry.UnitEntry_PMEntry_ID = tbl_PMEntry.PMEntry_PMHeader_ID " _
& "WHERE tbl_PMHeader.PMHeader_ID = " & num_PM _
& "GROUP BY tbl_UnitTypes.UnitTypes_WeeklyTextBoxUserEntryForm, " _
& " tbl_PMEntry.PMEntry_Week_Ending, " _
& " tbl_UnitTypes.UnitTypes_CumalativeTextBoxUserEntryForm ")
rst_UnitEntryCounts.MoveFirst
Do Until rst_UnitEntryCounts.EOF = True
[rst_UnitEntryCounts.UnitTypes_WeeklyTextBoxUserEntryForm] = SumOfUnitEntry_Unit_Count
rst_UnitEntryCounts.MoveNext
Loop
Exit Sub
image of what my query table looks like
Also, Im getting an error 3131 Syntax error in FROM clause as well.
Thanks in advance!
Finally figured out how to "place" a value (sum of units) in a textbox that varies based on criteria (unit type) in a form, where the name of the textbox is inside a record itself within my recordset. In case someone else has a similar question, here is how I did it:
Dim cntl As String
Dim frm As String
Dim rst_UnitEntry As Recordset
frm = "frm_UserEntry"
Set rst_UnitEntryCounts = CurrentDb.OpenRecordset("SELECT...)
If rst_UnitEntryCounts.RecordCount <> 0 Then
rst_UnitEntryCounts.MoveFirst
Do Until rst_UnitEntryCounts.EOF = True
If rst_UnitEntryCounts![UnitTypes_CumalativeTextBoxUserEntryForm] <> "" Then
cntl = rst_UnitEntryCounts![UnitTypes_CumalativeTextBoxUserEntryForm]
Forms(frm).Controls(cntl) = rst_UnitEntryCounts![SumOfUnitEntry_Unit_Count]
End If
rst_UnitEntryCounts.MoveNext
Loop
Based on this tutorial page, how does Microsoft Access know that a field created for an index fields collection associates to an equivalent field in the TableDef fields collection?
Even in this Microsoft Support page, fields are created for the index and then appended to the index's fields collection:
...
'Copy Indexes
For I1 = 0 To SourceTableDef.Indexes.Count - 1
Set SI = SourceTableDef.Indexes(I1)
If Not SI.Foreign Then ' Foreign indexes are added by relationships
Set I = T.CreateIndex()
' Copy Jet Properties
On Error Resume Next
For P1 = 0 To I.Properties.Count - 1
I.Properties(P1).Value = SI.Properties(P1).Value
Next P1
On Error GoTo 0
' Copy Fields
For f1 = 0 To SI.Fields.Count - 1
Set F = T.CreateField(SI.Fields(f1).Name, T.Fields(SI.Fields(f1).Name).Type)
I.Fields.Append F
Next f1
T.Indexes.Append I
End If
Next I1
...
Can't I simply add the existing field from the TableDef's fields collection? This makes little sense and seems to have very little in the way of cohesion.
Update
I actually tested the code here which is basically what I want to do ... but it fails with an undefined object error on this line:
Set F = T.CreateField(SI.Fields(f1).Name, T.Fields(SI.Fields(f1).Name).Type)
...and we have all sorts of fun when we change this.
(23/05/2016) Further, this script appears to be wrong - the second argument shouldn't actually be there, it's unnecessary. Omitting it causes further errors! Ha! Where's my tail? I'm getting the feeling that I should be chasing it.
A solution to my problem
I decided to follow HansUp's lead and use DDL - far easier than attempting to trawl through the problems associated to the manipulation of objects (though there was some level of this in the final code design)...
Option Compare Database
Public Const cFname As String = "drm\drmData2016.accdb"
Public Const cPropNotFound As Integer = 3270
Public Const cNotSupported As Integer = 3251
Public Const cInvalidOp As Integer = 3219
Public Sub GenerateTables()
OpenLog
'Initalise...
Dim db As Database
Dim tdb As Database
Dim ts As TableDef, tt As TableDef
Dim p As Property
Dim f As Field, ft As Field
Dim i As Index
Dim s As String, t As String
Dim x As Boolean
Set db = CurrentDb
If Dir$(cFname) <> "" Then Kill cFname
Set tdb = Application.DBEngine.CreateDatabase(cFname, dbLangGeneral, dbVersion140)
WriteLog "Created database " & cFname & "."
'Create the tables...
WriteLog "Creating TableDefs...", 1
For Each ts In db.TableDefs
If Not StartsWith(ts.Name, "msys", "~", "$", "Name AutoCorrect") And Not EndsWith(ts.Name, "_xrep") Then
s = "SELECT "
For Each f In ts.Fields
If Not StartsWith(f.Name, "s_", "S_") Then s = s & "[" & f.Name & "], "
Next f
s = Left$(s, Len(s) - 2) & " INTO [" & ts.Name & "] IN """ & cFname & """ FROM [" & ts.Name & "];"
On Error Resume Next
db.Execute s
If Err.Number = 0 Then
WriteLog "Created [" & ts.Name & "] using " & s, 2
Else
WriteLog "Failed to create [" & ts.Name & "].", 2
WriteLog "Error " & Err.Number & ": " & Err.Description, 3
WriteLog "SQL: " & s, 3
Err.Clear
End If
tdb.TableDefs.Refresh
On Error GoTo 0
End If
Next ts
'Copy the properties...
WriteLog "Tables...", 1
For Each ts In db.TableDefs
If Not StartsWith(ts.Name, "msys", "~", "$", "Name Autocorrect") And Not EndsWith(ts.Name, "_xrep") Then
Set tt = tdb.TableDefs(ts.Name)
WriteLog ts.Name, 2
WriteLog "Table Properties...", 3
'Table properties...
For Each p In ts.Properties
On Error Resume Next
tt.Properties(p.Name) = p.value
If Err.Number = 0 Then
WriteLog p.Name & " = " & p.value, 3
Else
WriteLog "Error setting " & p.Name, 3
WriteLog Err.Number & ": " & Err.Description, 4
Err.Clear
End If
On Error GoTo 0
Next p
'Field properties...
WriteLog "Fields...", 3
For Each f In ts.Fields
If Not StartsWith(f.Name, "s_") Then
Set ft = tt.Fields(f.Name)
WriteLog f.Name, 3
WriteLog "Properties...", 3
For Each p In f.Properties
On Error Resume Next
ft.Properties(p.Name).value = p.value
Select Case Err.Number
Case 0
'Normal...
WriteLog p.Name & " = " & p.value, 4
Case cPropNotFound
'Create the property...
Dim np As Property
Set np = ft.CreateProperty(p.Name, p.Type, p.value)
ft.Properties.Append np
ft.Properties.Refresh
WriteLog "Created property " & p.Name & ", value of " & p.value, 4
Case cNotSupported, cInvalidOp
'We're not worried about these values - simply skip over them...
Case Else
WriteLog "Failed to create or change property " & p.Name & ".", 4
WriteLog "Error " & Err.Number & ": " & Err.Description, 5
Err.Clear
End Select
On Error GoTo 0
Next p
End If
Next f
'Create the indexes...
WriteLog "Table indexes...", 2
For Each i In ts.Indexes
x = False
s = "CREATE "
If i.Unique Then s = s & "UNIQUE "
s = s & "INDEX [" & i.Name & "] ON [" & ts.Name & "] ("
For Each f In i.Fields
s = s & "[" & f.Name & "], "
'Just make sure we're not dealing with replication fields...
x = StartsWith(f.Name, "s_")
Next f
'We only want
If Not x Then
WriteLog i.Name, 3
s = Left$(s, Len(s) - 2) & ") "
If i.Primary Or i.IgnoreNulls Or i.Required Then
s = s & "WITH "
If i.Primary Then s = s & "PRIMARY "
If i.IgnoreNulls Then s = s & "IGNORE NULL "
If i.Required Then s = s & "DISALLOW NULL "
End If
s = s & ";"
On Error Resume Next
tdb.Execute s
Select Case Err.Number
'Note: used select case just in case I need to add extra error numbers...
Case 0
'Normal...
WriteLog "Created index [" & i.Name & "] using " & s, 4
Case Else
WriteLog "Failed to create index [" & ts.Name & "].", 4
WriteLog "Error " & Err.Number & ": " & Err.Description, 5
WriteLog "SQL: " & s, 3
Err.Clear
End Select
On Error GoTo 0
End If
Next i
End If
Next ts
'Belt and braces tidy-up...
Set p = Nothing
Set f = Nothing
Set ft = Nothing
Set i = Nothing
Set ts = Nothing
Set tt = Nothing
tdb.Close
Set tdb = Nothing
Set db = Nothing
WriteLog "Closed database."
WriteLog "Finished.", , False
CloseLog
End Sub
how does Microsoft Access know that a field created for an index
fields collection associates to an equivalent field in the TableDef
fields collection?
It checks based on the name. The name of the new index field must exist in the TableDef and that field's datatype must be one which is indexable. If either of those conditions is not satisfied, you will get an error message.
In summary:
An index is (from DAO point of view) basically a data structure with some properties and a collection of field names + their data types.
It is not a collection of pointers to tabledef fields.
To add fields to an index via DAO one needs a field object, which is created by CreateField().
The index object has a .CreateField() method too, which is actually the more common way to do this, I'd say.
From http://allenbrowne.com/func-dao.html#CreateIndexesDAO :
'3. Multi-field index.
Set ind = tdf.CreateIndex("FullName")
With ind
.Fields.Append .CreateField("Surname")
.Fields.Append .CreateField("FirstName")
End With
tdf.Indexes.Append ind
Note that this method doesn't take the Type and Size parameters, only the Name. I will happily admit that all this is a bit confusing (or incoherent, if you want).
I have an expenditures subform in Access 2010 that lists the predicted costs associated with the project for each year. Most projects only have one year, but some have more than one. Each cost has a Final checkbox next to it that should be checked when the amount is confirmed, ie. at the end of each year.
It basically looks something like this:
Year | Cost | Final
--------+-----------+--------------------
2017 | $100 | [checked box]
2018 | $200 | [unchecked box]
| | [unchecked box]
I have another field outside the table, FinalCost, that adds up everything in the Cost field. Right now, it fills in the amount from any year which has a checked Final box. That should only be filled when all the Final boxes are checked.
Ex. Right now, it should show nothing even though Final for 2017 is checked. When 2018 is checked, it should show $300. Instead, it shows $100 even though there's still an empty checkbox.
This is the code for this form.
Private Sub Form_AfterUpdate()
Dim rs1, rs2 As Recordset
Dim sql, sql2 As String
sql = "SELECT Sum(Amount) as Final From Expenditures " & _
"Where ProjNo = '" + Me.ProjNo + "' And Final = True Group by ProjNo"
sql2 = "SELECT FinalExpenditure From ActivityCash " & _
"Where ProjNo = '" + Me.ProjNo + "'"
Set rs1 = CurrentDb.OpenRecordset(sql, dbOpenDynaset, dpinconsistent)
Set rs2 = CurrentDb.OpenRecordset(sql2, dbOpenDynaset, dpinconsistent)
If rs1.RecordCount > 0 Then
If rs2.RecordCount > 0 Then
Do While Not rs2.EOF
rs2.Edit
rs2!FinalExpenditure = rs1!Final
rs2.Update
rs2.MoveNext
Loop
End If
End If
rs2.Close
rs1.Close
Set rs1 = Nothing
Set rs2 = Nothing
End Sub
What would be the best way to go about doing this?
EDIT: When the last box is checked, a new row is automatically added with an untoggled checkbox but no information.
Replace the statement beginning with sql = ... with this:
sql = "SELECT SUM(e1.Amount) AS Final " & _
" FROM Expenditures AS e1 " & _
" WHERE NOT EXISTS (SELECT 'x' FROM Expenditures e2 WHERE e2.Final=0 AND e1.ProjNo = e2.ProjNo) " & _
" AND e1.ProjNo = '" & Me.ProjNo & "'"
This query will return data only if there are all expeditures for the project marked as final. As you check for rs1.RecordCount > 0 there will be no update if this query returns no records.
So, before sql, I would verify that all records have True in your Final field.
To do that, let's just return a COUNT() of (any) records that have Final = False, and we can then decide to do what we want.
So, something like,
Dim Test as Integer
test = DCount("*", "YourTableName", "Final = False AND ProjNo = " & Me.ProjNo &"")
If test > 0 Then
'Don't fill the box
Else
'Fill the box, everything is True
'Read through your recordsets or whatever else you need to do
End If
To use a query, we essentially need to replicate the Dcount() functionality.
To do this, we need another Recordset variable, and we need to check the value of the Count() field from our query.
Create a query that mimicks this:
SELECT COUNT(*) As CountTest
FROM YourTable
HAVING Final = False
AND ProjNo = whateverprojectnumberyou'reusing
Save it, and remember that query's name.
Much like the DCount(), we need to make this "check" determine the route of your code.
Dim rst As DAO.Recordset
Set rst = CurrentDb.OpenRecordset("YourQuery'sNameHere")
If rst!CountTest > 0 Then
'They are not all Checked (aka True)
Else
'Supply the value to the FinalCost
End If
Set rst = Nothing
Change this:
sql = "SELECT Sum(Amount) as Final From Expenditures " & _
"Where ProjNo = '" + Me.ProjNo + "' And Final = True Group by ProjNo"
For this:
"SELECT SUM(Amount) - SUM(IIF(Final,1,0)*Amount) as YetToConfirm, SUM(Amount) as Confirmed From Expenditures " & _
"Where ProjNo = '" + Me.ProjNo + "' Group by ProjNo"
rs1 will return two values, the total value if all costs were confirmed in the rs1!Confirmed, and the value yet to confirm in rs1!YetToConfirm
Then here:
Do While Not rs2.EOF
rs2.Edit
rs2!FinalExpenditure = rs1!Final
rs2.Update
rs2.MoveNext
Loop
change it to:
Do While Not rs2.EOF
rs2.Edit
rs2!FinalExpenditure = Iif(rs1!YetToConfirm = 0, rs1!Confirmed, 0)
rs2.Update
rs2.MoveNext
Loop
One way to process this would be check using a subquery whether last year(verified using a dmax function) in each project has been checked in the final column, if this is true, get your sum of checked amounts, else dont calculate the sum.
I have modified your sql string to include this and I tested it against your given example to confirm its showing a sum of $300 or nothing.
SQL = ""
SQL = SQL & " SELECT Sum(Amount) as Final From Expenditures "
SQL = SQL & " Where ProjNo = '" & Me.ProjNo & "' And Final = True "
SQL = SQL & " And (SELECT Expenditures.Final FROM Expenditures where year = ( "
SQL = SQL & " DMax('Year','Expenditures','ProjNo= " & Chr(34) & Me.ProjNo & Chr(34) & "'))) = true "
SQL = SQL & " Group by ProjNo "
I have retrieve all data from the internet into a 2 dimension array, I know how to use vba recordset and by filter and update using loop. Below is part of the code in vba.
the difficult problem is here:
Using cmd As New MySqlCommand("INSERT INTO `calls` (`CID`, `ctype`) VALUES (#CID, #ctype)", cnn)
This make me could not use any loop through the array and update accordingly.
cmd.Parameters.Add ('#CID').value = arrValue(i,j)
I hope this could be done in kind of below:
for x = 0 to ubound(arrValue,0)
for y = 0 to ubound(arrValue,1)
.fields(arrHeader(y) = arrValue(x,y)
next y
next x
say i, the n-th to be updated, j = the value of the header
extract of vba:
With rs
'Worksheets(strWsName).Activate
'iLastRow = Worksheets(strWsName).Cells(65535, 1).End(xlUp).row 'column B, column 2
For i = 0 To UBound(arrValue, 1)
Debug.Print "Updating " & i + 1 & " of " & UBound(arrValue, 1) + 1 & " news ..." ' of " & strCodeAB & " ..."
'Start looping the news row
strNewsID = arrValue(i, 1) 'Worksheets(strWsName).Range(ColRefNewsID & i).Value
If strNewsID = "" Then
Debug.Print i - 1 & " news is updated to database"
i = UBound(arrValue, 1)
Else
strFilter = "fID='" & strNewsID & "'"
rs.Filter = strFilter
If rs.EOF Then
.AddNew 'create a new record
'add values to each field in the record
For j = 0 To UBound(arrTitle_ALL)
'20140814
strFieldValue = .Fields(arrAccessField(j))
strNewValue = arrValue(i, j)
If IsNull(strFieldValue) And strNewValue = "" Then
Else
.Fields(arrAccessField(j)) = arrValue(i, j) 'Worksheets(strWsName).Cells(i, j + 1).Value
End If
Next j
On Error Resume Next '***************
.Update 'stores the new record
On Error GoTo 0
iCounterNewsAdded = iCounterNewsAdded + 1
glcounterNewsAdded = iCounterNewsAdded
Else
It seems that the below post similar to my request but I don't know how to do so.
[reference]passing an Array as a Parameter to be used in a SQL Query using the "IN" Command
The post you mention (Using the IN() command) works in your WHERE clause but it is not valid for values. MySQL has no way to pass an array so you need to loop through your array and run multiple INSERT statements:
for y = 0 to ubound(arrValue,1)
cmd.Parameters.AddWithValue(#CID,arrValue(0,y))
cmd.Parameters.AddWithValue(#ctype,arrValue(1,y))
cmd.ExecuteNonQuery
next y