I have a listbox with multiselect that provides multiple values.I need a select statement from the below
select Amount from tblEmployeeTransactions _
where PayrollCode_Code = '" & code & "' "
my listboxdata is obtained as below
For Each drv As CListItem In lstnoncash.SelectedItems
code =drv.ItemData
Next
my desired query should be
select sum(Amount) from tblEmployeeTransactions _
where PayrollCode_Code = '1' or PayrollCode_Code ='2' or PayrollCode_Code ='3'"
If it has 3 rows of data
You may want something like this :
Dim a As String() = {"1", "2", "3"}
Dim query = "select sum(Amount) from tblEmployeeTransactions " _
& "where PayrollCode_Code IN "
'here inStatement will contain : ('1', '2', '3')'
Dim inStatement = "('" & String.Join("', '", a) & "')"
Console.WriteLine(query & inStatement)
Is you PayrollCode_Code numeric? if yes then you don't need to add single quotation for that. And I prefer to use IN statement instead of multiple OR operator.
Dim sCode As String
For Each drv As CListItem In lstnoncash.SelectedItems
sCode &= drv.ItemData & ","
Next
IF sCode.Length > 0 THEN
sCode = sCode.Substring(0,sCode.Length-1);
Dim _SQL As String = "Select SUM(Amount) FROM tblEmployeeTransactions " &
"WHERE PayrollCode_Code IN (" & sCode & ")"
''Execute ur _SQL
END IF
Related
I need a macro in VBA Access. I have a table with all dates of the years like columns (and also the dates are the names of the fields). I've made a form where the user selects two dates, and the macro would count all the data between these 2 columns.
For the example, I put two fixed dates. The problem is I need count between the 2 columns, and the columns can change depending the input of the user. The table is EVOLUTIVO_ASISTENCIA and the field can change depends the user selection. Ihe following code EVOLUTIVO_ASISTENCIA.[" & INICIO_MES_VAR1 & "] is the field "01-01-2023" of the EVOLUTIVO_ASISTENCIA table, but the syntax is wrong and does not function. Can anyone help me?
The code:
Private Sub BUSQUEDA()
Dim CONTEO As String
Dim VAR1 As String
Dim INICIO_MES_VAR1 As Date, TERMINOS_MES_VAR1 As Date
INICIO_MES_VAR1 = Format("01-01-2023", "dd-mm-yyyy")
TERMINOS_MES_VAR1 = Format("31-01-2023", "dd-mm-yyyy")
VAR1 = "VAR1"
CONTEO = "SELECT COUNT(*) FROM EVOLUTIVO_ASISTENCIA " & _
"WHERE EVOLUTIVO_ASISTENCIA.[NOMBRES]='" & VAR1 & "' " & _
** "BETWEEN EVOLUTIVO_ASISTENCIA.[" & INICIO_MES_VAR1 & "] AND EVOLUTIVO_ASISTENCIA.[" & TERMINOS_MES_VAR1 & "]"**
DoCmd.RunSQL CONTEO
End Sub
You don't run a select query, you open it as a recordset. So try:
Private Sub BUSQUEDA()
Dim Records As DAO.Recordset
Dim CONTEO As String
Dim VAR1 As String
Dim INICIO_MES_VAR1 As String
Dim TERMINOS_MES_VAR1 As String
Dim ASISTENCIA_CONTEO As Long
INICIO_MES_VAR1 = "01-01-2023"
TERMINOS_MES_VAR1 = "31-01-2023"
VAR1 = "VAR1"
CONTEO = "SELECT COUNT(*) FROM EVOLUTIVO_ASISTENCIA " & _
"WHERE EVOLUTIVO_ASISTENCIA.[NOMBRES]='" & VAR1 & "' " & _
"BETWEEN EVOLUTIVO_ASISTENCIA.[" & INICIO_MES_VAR1 & "] AND EVOLUTIVO_ASISTENCIA.[" & TERMINOS_MES_VAR1 & "]"
Set Records = CurrentDb.OpenRecordset(CONTEO)
' Read/list/print records.
' Retrieve the value of the first and only field of the first and only record.
ASISTENCIA_CONTEO = Records(0).Value
' Close when done.
Records.Close
End Sub
Apologies for the vague title, but here is my issue. I have a form that has several select lists and associated text boxes. Basically the way it works is if you select a name from the first list, an AfterUpdate event is triggered to query the DB to see if the Eng_ID and Person_ID already exist in the table. If so, then delete that row then insert the updated row. If there is not any records, then just insert the data. The problem is that when I click a name in the first list, then move to the second list, what's happening is that the the Person_ID of the first list is used for the DLookup query, then it delets the record, then inserts the record of the new person I selected in a different listbox. The code is below: Thanks in advance
' Add/Remove Participant 1
Private Sub lstPar1_AfterUpdate()
Dim n As Integer
Dim strCriteria As String
Dim strSQL As String
With Me.lstPar1
For n = .ListCount - 1 To 0 Step -1
strCriteria = "Eng_ID = " & Nz(Me.Eng_ID, 0) & " And Person_ID = " & .ItemData(n)
If .Selected(n) = False Then
' If a person has been deselected, then delete row from table
If Not IsNull(DLookup("Eng_ID", "tblEngParRole", strCriteria)) Then
strSQL = "DELETE * FROM tblEngParRole WHERE " & strCriteria
CurrentDb.Execute strSQL, dbFailOnError
End If
Else
' If a person has been selected, then insert row into the table
If IsNull(DLookup("Eng_ID", "tblEngParRole", strCriteria)) Then
strSQL = "INSERT INTO tblEngParRole (Eng_ID, Person_ID, ParticipantNumber, Role)" & "VALUES(" & Me.Eng_ID & "," & .ItemData(n) & "," & 1 & ",'" & Me.txtParRole1.Value & "' )"
CurrentDb.Execute strSQL, dbFailOnError
End If
End If
Next n
End With
End Sub
' Add/Remove Participant 2
Private Sub lstPar2_AfterUpdate()
Dim n As Integer
Dim strCriteria As String
Dim strSQL As String
With Me.lstPar2
For n = .ListCount - 1 To 0 Step -1
strCriteria = "Eng_ID = " & Nz(Me.Eng_ID, 0) & " And Person_ID = " & .ItemData(n)
If .Selected(n) = False Then
' If a person has been deselected, then delete row from table
If Not IsNull(DLookup("Eng_ID", "tblEngParRole", strCriteria)) Then
strSQL = "DELETE * FROM tblEngParRole WHERE " & strCriteria
CurrentDb.Execute strSQL, dbFailOnError
End If
Else
' If a person has been selected, then insert row into the table
If IsNull(DLookup("Eng_ID", "tblEngParRole", strCriteria)) Then
strSQL = "INSERT INTO tblEngParRole (Eng_ID, Person_ID, ParticipantNumber, Role) " & "VALUES(" & Me.Eng_ID & "," & .ItemData(n) & "," & 2 & ",'" & Me.txtParRole2.Value & "' )"
CurrentDb.Execute strSQL, dbFailOnError
End If
End If
Next n
End With
End Sub
Using this image, if I select Daniel and enter his role, then the eng_ID, Person_ID, ParticipantNumber and Role are entered into the database as 130, 118, 1, Collaborator.
If I select Kristin, it deletes Daniel becuause it's still using Person_ID of 118 instead of hers which is 134, and since there is a corresponding record, it delets Daniel then adds Kristin.
I don't have Access to test this with, but it seems like you need to separate Participant1 records from Participant2 records when you perform your DLookups.
Also you can generalize your code by pulling the common parts into a separate sub.
Private Sub lstPar1_AfterUpdate()
CheckParticipant Me.lstPar1, 1, Me.txtParRole1.Value
End Sub
Private Sub lstPar2_AfterUpdate()
CheckParticipant Me.lstPar2, 2, Me.txtParRole2.Value
End Sub
Sub CheckParticipant(objList As Object, participantNum As Long, role As String)
Dim n As Integer
Dim strCriteria As String
Dim strSQL As String
With objList
For n = .ListCount - 1 To 0 Step -1
strCriteria = "Eng_ID = " & Nz(Me.Eng_ID, 0) & " And Person_ID = " & .ItemData(n) & _
" And ParticipantNumber=" & participantNum
strSQL = ""
If Not .Selected(n) Then
' If a person has been deselected, then delete row from table
If Not IsNull(DLookup("Eng_ID", "tblEngParRole", strCriteria)) Then
strSQL = "DELETE * FROM tblEngParRole WHERE " & strCriteria
End If
Else
' If a person has been selected, then insert row into the table
If IsNull(DLookup("Eng_ID", "tblEngParRole", strCriteria)) Then
strSQL = "INSERT INTO tblEngParRole (Eng_ID, Person_ID, ParticipantNumber, Role)" & _
" VALUES(" & Me.Eng_ID & "," & .ItemData(n) & "," & participantNum & _
",'" & role & "' )"
End If
End If
If Len(strSQL) > 0 Then CurrentDb.Execute strSQL, dbFailOnError
Next n
End With
End Sub
I have one table and one query. Both have the same data field but table COLUMN names are equal to query's ROW name. I update table from query's row data using the following code successfully but it takes too much time to update as there are more than 50 columns name in the table for each employee-
Set rst1 = CurrentDb.OpenRecordset("SELECT * FROM tblPayRollDataTEMP")
Set rst2 = CurrentDb.OpenRecordset("SELECT * FROM qryEmpVerifySalary ")
Do Until rst1.EOF
rst2.MoveFirst
Do Until rst2.EOF
For l = 0 To rst1.Fields.count - 1
If rst1!EmpID = rst2!EmpID And rst1.Fields(l).Name = rst2!Head And rst1!PayBillID = TempVars!BillID Then
With rst1
rst1.Edit
rst1.Fields(l).Value = rst2!Amount
rst1!totDeductions = DSum("Amount", "qryEmpVerifySalary", "[PayHeadType] = 'Deductions' AND [EmpID] = " & rst2!EmpID & "") + DLookup("NPS", "qryEmpPayEarning", "[EmpID] = " & rst2!EmpID & "")
rst1!totRecoveries = DSum("Amount", "qryEmpVerifySalary", "[PayHeadType] = 'Recoveries' AND [EmpID] = " & rst2!EmpID & "")
rst1!NetPayable = rst1!totEarnings - (Nz(rst1!totDeductions, 0) + Nz(rst1!totRecoveries, 0))
rst1.Update
End With
End If
Next
rst2.MoveNext
Loop
rst1.MoveNext
Loop
Set rst1 = Nothing
Set rst2 = Nothing
How to improve the performance of the code?
You should use a query to update your records. This would be the fastest solution. Normally one would match the EmpID and drag and drop the fields into the update query or use an expression. If you have to group before or other complex stuff split it in more querys (two or three). It doesnt matter thou, because in the end you just execute one update query.
For your code, you can replace the domainaggregate functions. DLookup(), DSum(), etc... these are worst for performance. A simple select statement runs way faster than DLookup(). Here are a few replacements:
Function DCount(Expression As String, Domain As String, Optional Criteria) As Variant
Dim strSQL As String
strSQL = "SELECT COUNT(" & Expression & ") FROM " & Domain
'Other Replacements:
'DLookup: strSQL = "SELECT " & Expression & " FROM " & Domain
'DMax: strSQL = "SELECT MAX(" & Expression & ") FROM " & Domain
'DMin: strSQL = "SELECT SUM(" & Expression & ") FROM " & Domain
'DFirst: strSQL = "SELECT FIRST(" & Expression & ") FROM " & Domain
'DLast: strSQL = "SELECT LAST(" & Expression & ") FROM " & Domain
'DSum: strSQL = "SELECT SUM(" & Expression & ") FROM " & Domain
'DAvg: strSQL = "SELECT AVG(" & Expression & ") FROM " & Domain
If Not IsMissing(Criteria) Then strSQL = strSQL & " WHERE " & Criteria
DCount = DBEngine(0)(0).OpenRecordset(strSQL, dbOpenForwardOnly)(0)
End Function
I've created DB within Access and given Data Type "Short Text."
Now I'm trying to prompt record into this table through Visual Basic. I wrote a code so far but need help to fix an error. I'm getting the compile error:
Duplicate declaration in current scope
I can't figure it out what it is?
Option Compare Database
Sub arrayData()
Dim CustomerName() As Variant
Dim num As Integer, dbs As Database, InsertRecord As String
Dim CustomerID As Long, num1 As Long, CustomerName As String
Set dbs = CurrentDb()
CustomerID = 0
For num1 = 0 To 49999
CustomerID = CustomerID + 1
CustomerName = Array("Peter", "Mary")
CustomerAddress = Array("163 City Rd, SOUTHBANK", "65 Orange St, BENTLEIGH EAST")
CustomerPhoneAddress = Array("0416874963", "0478937534")
num = Int((200 - 0 + 1) * Rnd + 0)
CustomerName = CustomerName(num)
CustomerAddress = CustomerAddress(num)
CustomerPhoneNo = CustomerPhoneNo(num)
InsertRecord = "INSERT INTO Customers (CustomerID,CustomerName,CustomerAddress,CustomerPhoneNo) VALUES (" & "'" & CustomerID & "'" & "," & "'" & CustomerName & "'" & "," & "'" & CustomerAddress & "'" & "," & "'" & CustomerPhoneNo & "'" & ")"
dbs.Execute InsertRecord
Debug.Print CustomerID, CustomerName, CustomerAddress, CustomerPhoneNo
Next
End Sub
What can I do in this situation? Any help would be appreciated.
The language you are using is "Visual Basic for Applications" (VBA). This language is line-oriented. It menas that one statement must fit on one single line, unless you are using a line continuation character (_) preceeded by at least one whitespace.
Dim CustomerID As Long, num1 As Long, CustomerName As String, CustomerAddress _
As String, CustomerPhoneNo As String
But I would place the Long and String variables on separate lines and write:
Dim CustomerID As Long, num1 As Long
Dim CustomerName As String, CustomerAddress As String, CustomerPhoneNo As String
The second syntax error is in the InsertRecord = "INSERT INTO ... statement. same problem here. It shoul look like this:
InsertRecord = "INSERT INTO CUSTOMERS (CustomerID,CustomerName," _
& "CustomerAddress,CustomerPhoneNo) VALUES " _
& "(" & "'" & CustomerID & "'" & "," & "'" & CustomerName & "'" & "," & "'" _
& CustomerAddress & "'" & "," & "'" & CustomerPhoneNo & "'" & ")"
Also, what are the - 0 and + 0 good for in Int((200 - 0 + 1) * Rnd + 0). The expression is equivalent to Int(201 * Rnd).
After your edits it seems that you have no line continuations.
THE ERROR IS: You have 2 variables named CustomerName. Variable names must be unique:
Dim CustomerName() As Variant
Dim CustomerName As String
For instance, name the array CustomerNames:
Dim CustomerNames() As Variant
And you should indent your code. It makes it much easier to read.
Sub arrayData()
Dim CustomerName() As Variant
...
CustomerID = 0
For num1 = 0 To 10
CustomerID = CustomerID + 1
...
Debug.Print CustomerID, CustomerName, CustomerAddress, CustomerPhoneNo
Next
End Sub
I would like to create a VBScript that read a SQL server database and generate a SQL simple query for each table of one shema of the database and store this SQL into a separate file on disk.
Example :
table A :
ID
field1
field2
field3
table B :
ID
field4
field5
Would generate 2 SQL files :
File 1 : tableA.SQL
SELECT
ID,
field1,
field2,
field3
FROM table A
ORDER BY ID
File 2 : tableB.SQL
SELECT
ID,
field4,
field5
FROM table B
ORDER BY ID
Purpose of this request:
to have an automated testing suite running with all these queries on two copy of the database to find difference on structure and/or data, using NUnit + ORAYLIS BI.Quality http://biquality.codeplex.com/
Given
the decision to use ADOX instead of .OpenSchema
a valid connection to your database (oConn)
a valid path to the folder to store the .sql files in (sDDir)
a global FileSystemObject (goFS)
this
Sub genTS(oConn, sDDir)
Dim oCatalog : Set oCatalog = CreateObject( "ADOX.Catalog" )
Set oCatalog.ActiveConnection = oConn
Dim oTable
For Each oTable In oCatalog.Tables
If "TABLE" = oTable.Type Then
WScript.Echo oTable.Name
ReDim aColumns(oTable.Columns.Count - 1)
Dim i : i = 0
Dim oColumn
For Each oColumn In oTable.Columns
WScript.Echo " ", oColumn.Name
aColumns(i) = oColumn.Name
i = i + 1
Next
Dim sSQL : sSQL = Join(Array( _
"SELECT" _
, "[" & Join(aColumns, "], [") & "]" _
, "FROM [" & oTable.Name & "]" _
, "ORDER BY [" & aColumns(0) & "]" _
), " ")
WScript.Echo " ", sSQL
goFS.CreateTextFile(goFS.BuildPath(sDDir, oTable.Name & ".sql")).WriteLine sSQL
End If
Next
End Sub
should work in principle. Output:
Alpha
Id
StartDate
EndDate
Value
SELECT [Id], [StartDate], [EndDate], [Value] FROM [Alpha] ORDER BY [Id]
...
type ..\data\21751835\Alpha.sql
SELECT [Id], [StartDate], [EndDate], [Value] FROM [Alpha] ORDER BY [Id]
You may have to tinker with the way to specify the order column.
Update:
Maybe the decision (1) was wrong. There may be a way to get a schema name from an ADOX table object, but I can't find it at the moment. So let's use .OpenSchema:
Sub genTS(oConn, sDDir)
Const adSchemaTables = 20
Const adSchemaColumns = 4
Dim rsTables : Set rsTables = oConn.OpenSchema(adSchemaTables, Array(Empty, <YourSchemaName>, Empty, "TABLE"))
Do Until rsTables.EOF
Dim sTName : sTName = rsTables.Fields("TABLE_NAME").Value
WScript.Echo sTName, rsTables.Fields("TABLE_SCHEMA").Value
Dim rsColumns : Set rsColumns = oConn.OpenSchema(adSchemaColumns, Array(Empty, Empty, sTName))
ReDim aColumns(-1)
Do Until rsColumns.EOF
Dim sFName : sFName = rsColumns.Fields("COLUMN_NAME").Value
WScript.Echo " ", sFName
ReDim Preserve aColumns(UBound(aColumns) + 1)
aColumns(UBound(aColumns)) = sFName
rsColumns.MoveNext
Loop
Dim sSQL : sSQL = Join(Array( _
"SELECT" _
, "[" & Join(aColumns, "], [") & "]" _
, "FROM [" & sTName & "]" _
, "ORDER BY [" & aColumns(0) & "]" _
), " ")
WScript.Echo " ", sSQL
goFS.CreateTextFile(goFS.BuildPath(sDDir, sTName & ".sql")).WriteLine sSQL
rsColumns.Close
rsTables.MoveNext
Loop
rsTables.Close
End Sub