I have a query that gives me the Current Employee Rate based on the WorkDay:
(Select Top 1 T1.Rate FROM tblERates as T1
WHERE T1.EMPID = tblPayroll.EMPID And T1.EffectiveDate <= tblPayroll.WorkDay
ORDER BY T1.EMPID asc, T1.EffectiveDate desc)
The project is growing. I need to return the Employee Rate on different Forms/Reports so I want to convert this SQL to a Public Function.
I tried this:
Public Function fncERate(EID As Integer, WD As Date) As Double
Dim intERate As Double
Dim intWD As String
intWD = "#" & Format(WD, "m/d/yyyy") & "#"
intERate = "SELECT TOP 1 Rate" _
& "FROM tblERates" _
& "WHERE EMPID = EID And EffectiveDate <= intWD" _
& "ORDER BY EMPID asc;"
fncERate = intERate
End Function
I get a "type mismatch error".
After tinkering a bit I came up with this:
Public Function fncERate(EID As Integer, WD As Date) As Double
Dim intERate As String
Dim intWD As String
Dim intEID As Integer
intWD = "#" & Format(WD, "m/d/yyyy") & "#"
intERate = "SELECT TOP 1 [Rate]" & _
" FROM tblERates" & _
" WHERE [EMPID] = " & EID & " And [EffectiveDate] <= " & intWD & " " & _
" ORDER BY [EMPID] asc;"
With CurrentDb.OpenRecordset(intERate)
If Not (.BOF And .EOF) Then
fncERate = .Fields(0)
End If
End With
End Function
Yes you lack spaces in your sql syntax
A little tip for quick dev
Press Ctrl+G to open execution pane while debugging and type
?intERate
to print the value of your variable
then you can just copy paste the sql and try it directly
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
I want to insert multiple rows in the table below, but I'm getting this error Run-time error 3061, too few parameters expected 1 Of course I did something wrong here, but I don't understand what I did wrong.
Table:InstructorAttendance
ID = AutoNumber (long integer)
AttnID = Number (long integer) pk
IUID = Number (long integer) not null
AttnDate = DateTime not null
AttnStatus = Number (long integer)
MS = Calculated field
MN = Calculated field
The code with which I am trying to insert data is described below:
Private Sub cmdGenerate_Click()
Dim DateExist As Integer
Dim Filter As String
Dim strDate, FD, LD As Date
Dim NextDate As Date
strDate = CDate(Me.frmMonth & "/" & Me.cboYear)
FD = DateSerial(Year(strDate), Month(strDate), 1)
LD = DateSerial(Year(strDate), Month(strDate) + 1, 1) - 1
DateExist = DCount("AttnDate", "InstructorAttendance", "AttnDate>=#" & [FD] & "# And AttnDate<=#" & [LD] & "# And IUID=" & Me.[IUID])
If DateExist > 0 Then
Debug.Print "exist"
Else
NextDate = FD
While DateDiff("d", NextDate, LD) >= 0
DoCmd.SetWarnings False
CurrentDb.Execute "INSERT INTO InstructorAttendance (AttnID, IUID, AttnDate) " & _
"Values (" & DMax("AttnID", "InstructorAttendance") + 1 & ", " & Me.IUID & ", NextDate)"
DoCmd.SetWarnings True
NextDate = DateAdd("d", 1, NextDate)
Wend
End If
End Sub
Concatenate NextDate variable with # delimiters.
& ", " & Me.IUID & ", #" & NextDate & "#)"
I have fields which have as name a the date of delivery, as you can see here:
I have around 75 columns like that. I have a bug when I want to compute the value P1 because it does not find the field. BTW, I have very stranges values for my coefficients T1, T2 (which are dates) and thus A and B which are datediff. There is the code:
Sub vcm_fc()
Dim db As Database, T As Date, longest As Integer, nearest_date As Date, rsb As DAO.Recordset, strsqlb As String
Dim strsqla As String, rsa As Recordset, maturity As Date, T1 As Date, T2 As Date, P1 As Double, P2 As Double
Dim a As Integer, B As Integer, j As Integer, rsc As DAO.Recordset, strqlc As String, settlementbis As String
Dim settlement As String, maturitybis As Date, ym As Integer, ymbis As Integer
Set db = CurrentDb()
T = DateSerial(2020, 8, 15)
nearest_date = DFirst("PricingDate", "fc_historical")
longest = DateDiff("m", nearest_date, T)
db.Execute "CREATE TABLE time_series " _
& "(PricingDate CHAR);"
db.Execute " INSERT INTO time_series " _
& "SELECT PricingDate " _
& "FROM fc_historical " _
& "ORDER BY PricingDate;"
For i = 1 To longest
db.Execute " ALTER TABLE time_series " _
& "ADD COLUMN F_" & i & " Number;"
strsqla = "SELECT PricingDate, F_" & i & " FROM time_series ORDER BY PricingDate"
Set rsa = db.OpenRecordset(strsqla, dbOpenDynaset)
rsa.MoveFirst
rsa.Delete 'delete the first row which is blank when the time series table is created'
rsa.MoveFirst
While (Not rsa.EOF())
rsa.Edit
maturity = DateAdd("m", i, rsa.Fields("PricingDate").Value)
ym = Year(maturity) - 2000
settlement = "1/" & Month(maturity) & "/" & ym
strsqlb = "SELECT Pricingdate, " & settlement & " FROM fc_historical ORDER BY PricingDate;"
Set rsb = db.OpenRecordset(strsqlb, dbOpenDynaset)
rsb.MoveLast
T1 = rsb.Fields("PricingDate").Value
maturitybis = DateAdd("m", i, maturity)
ymbis = Year(maturitybis) - 2000
settlementbis = "1/" & Month(maturitybis) & "/" & ymbis
strsqlc = "SELECT Pricingdate, " & settlementbis & " FROM fc_historical ORDER BY PricingDate;"
Set rsc = db.OpenRecordset(strsqlc, dbOpenDynaset)
rsc.MoveLast
T2 = rsc.Fields("PricingDate").Value
a = DateDiff("d", T1, rsa.Fields("PricingDate").Value)
B = DateDiff("d", rsa.Fields("PricingDate").Value, T2)
P1 = rsb.Fields(settlement).Value
P2 = rsc.Fields(settlementbis).Value
rsa.Fields("F_" & i) = (P1 * B + P2 * a) / (a + B)
rsa.Update
rsa.MoveNext
Wend
Next i
End Sub
Have added as an answer so I can get the format for the code. This code will take your date field names and place them as record values - you may need to muck around with the fld.Name to make sure it isn't US date format (8th Jan, 9th Jan, etc for your table example) along with the price for that date.
Sub Put_Field_Names_As_Record_Values()
Dim DB As DAO.Database
Dim OldTable As DAO.TableDef
Dim fld As DAO.Field
Set DB = CurrentDb()
Set OldTable = DB.TableDefs("time_series")
DoCmd.SetWarnings False
For Each fld In OldTable.Fields
If IsDate(fld.Name) Then
Debug.Print fld.Name & " : " & SQLDate(fld.Name)
DoCmd.RunSQL "INSERT INTO MyNewTable (PricingDate, SettlementDate, Price) " & _
"SELECT PricingDate," & SQLDate(fld.Name) & ", [" & fld.Name & "] FROM time_series"
End If
Next fld
DoCmd.SetWarnings True
End Sub
Function SQLDate(varDate As Variant) As String
'Purpose: Return a delimited string in the date format used natively by JET SQL.
'Argument: A date/time value.
'Note: Returns just the date format if the argument has no time component,
' or a date/time format if it does.
'Author: Allen Browne. allen#allenbrowne.com, June 2006.
If IsDate(varDate) Then
If DateValue(varDate) = varDate Then
SQLDate = Format$(varDate, "\#mm\/dd\/yyyy\#")
Else
SQLDate = Format$(varDate, "\#mm\/dd\/yyyy hh\:nn\:ss\#")
End If
End If
End Function
You can then run queries on the table:
SELECT SUM(Price)
FROM MyNewTable
WHERE PricingDate<=#07/16/2014# AND SettlementDate=#01/08/2014#
Edit: Test on a copy of your database!!
Edit 2: Manually create the MyNewTable and set PricingDate and SettlementDate as key fields.
I've updated to convert the field name into the correct date - http://allenbrowne.com/ser-36.html
On my test it converted all dates to the first of each month correctly.
Use properly formatted date expressions:
settlementbis = "#" & CStr(ymbis) & "/" & CStr(Month(maturitybis)) & "/1#"
And do listen to Darren about normalisation.
I am trying to create a Parameter Query in Access 2007 VBA that takes two input parameters from user forms and also returns a derived field value based on the public function RESULT I have written elsewhere in the code. The function determines the value of a calculated "Result" field which is derived from the values of 4 fields in the underlying table, [HomeTeam],[AwayTeam],[HomeGoals],[AwayGoals].
If I debug the code through the immediate window and paste the SQL string into the Access SQL window the query runs perfectly but will not run from VBA. The error generated is:
"Run-time error 3141. The SELECT statement includes a reserved word or an argument name that is misspelled or missing, or the punctuation is incorrect."
I do not want to run the query directly in Access as the Parameter [season] is a table variable.
Does anybody know if and how I can call a user defined function in VBA within a SQL string?
I am unsure if this is just a syntax problem.
Code:
Sub sqlSeason()
Dim db As DAO.Database
Dim qdef As DAO.QueryDef
Dim season As String
Dim team As String
Dim strSQL As String
Set db = CurrentDb()
DoCmd.Close acQuery, "qrySeason"
db.QueryDefs.Delete "qrySeason"
season = [Forms]![frmSeason]![comboSeason]
strSQL = "PARAMETERS [Forms]![frmClubProfile]![comboTeam] Text (255), [Forms]![frmSeason]![comboSeason] Text (255) ;" & _
"SELECT [Date], [HomeTeam], [AwayTeam], [HomeGoals], [AwayGoals], Result([HomeTeam], [AwayTeam], [HomeGoals], [AwayGoals]) AS Result" & _
"FROM [" & [season] & "]" & _
"GROUP BY [Date], [HomeTeam], [AwayTeam], [HomeGoals], [AwayGoals], Result([HomeTeam], [AwayTeam], [HomeGoals], [AwayGoals])" & _
"HAVING ((([" & [season] & "].HomeTeam) = [Forms]![frmClubProfile]![comboTeam])) Or ((([" & [season] & "].AwayTeam) = [Forms]![frmClubProfile]![comboTeam]))" & _
"ORDER BY [Date];"
Debug.Print strSQL
Set qdef = db.CreateQueryDef("qrySeason", strSQL)
DoCmd.OpenQuery "qrySeason"
End Sub
Function:
Public Function Result(ByRef HomeTeam As String, ByRef AwayTeam As String, ByRef HomeGoals As Integer, ByRef AwayGoals As Integer) As String
team = [Forms]![frmClubProfile]![comboTeam]
If team = HomeTeam And HomeGoals > AwayGoals Then
result = "Home Win"
End If
If team = HomeTeam And HomeGoals = AwayGoals Then
result = "Home Draw"
End If
If team = HomeTeam And HomeGoals < AwayGoals Then
result = "Home Lost"
End If
If team = AwayTeam And HomeGoals < AwayGoals Then
result = "Away Win"
End If
If team = AwayTeam And HomeGoals = AwayGoals Then
result = "Away Draw"
End If
If team = AwayTeam And HomeGoals > AwayGoals Then
result = "Away Lost"
End If
End Function
Why does this work in Access but not in VBA?
Any help would be appreciated.
Try this to expand your form values inside of the string before it is evaluated:
"SELECT [Date], [HomeTeam], [AwayTeam], [HomeGoals], [AwayGoals], Result([HomeTeam], [AwayTeam], [HomeGoals], [AwayGoals]) AS Result" & _
"FROM [" & [season] & "]" & _
"GROUP BY [Date], [HomeTeam], [AwayTeam], [HomeGoals], [AwayGoals], Result([HomeTeam], [AwayTeam], [HomeGoals], [AwayGoals])" & _
"HAVING ((([" & [season] & "].HomeTeam) = '" & [Forms]![frmClubProfile]![comboTeam] & "'")) Or ((([" & [season] & "].AwayTeam) = '" & [Forms]![frmClubProfile]![comboTeam] & "'))" & _
"ORDER BY [Date];"
Value being expanded:
[Forms]![frmClubProfile]![comboTeam]
Assuming comboTeam is a string, if it is numeric, skip the single quotes.
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