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 & "#)"
Related
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
Here we are finding the eight adjacent numbers that have the highest sum and displaying that sum. We also need to have it display the eight adjacent numbers that add up to this value. I am stuck on how to display these values. My code for what I have so far is below:
Dim chars As Char() = "73167176531330624919225119674426574742355349194934" &
"96983520312774506326239578318016984801869478851843" &
"85861560789112949495459501737958331952853208805511" &
"12540698747158523863050715693290963295227443043557" &
"66896648950445244523161731856403098711121722383113" &
"62229893423380308135336276614282806444486645238749" &
"30358907296290491560440772390713810515859307960866" &
"70172427121883998797908792274921901699720888093776" &
"65727333001053367881220235421809751254540594752243" &
"52584907711670556013604839586446706324415722155397" &
"53697817977846174064955149290862569321978468622482" &
"83972241375657056057490261407972968652414535100474" &
"82166370484403199890008895243450658541227588666881" &
"16427171479924442928230863465674813919123162824586" &
"17866458359124566529476545682848912883142607690042" &
"24219022671055626321111109370544217506941658960408" &
"07198403850962455444362981230987879927244284909188" &
"84580156166097919133875499200524063689912560717606" &
"05886116467109405077541002256983155200055935729725" &
"71636269561882670428252483600823257530420752963450"
Dim index As String = 0
Dim x = 0
Dim values = Array.ConvertAll(chars, Function(c) CInt(c.ToString()))
Dim maxSum = 0
For i = 0 To values.Length - 8
Dim sum = values(i)
For x = i + 1 To i + 7
sum += values(x)
index = i
Next
If sum > maxSum Then
maxSum = sum
End If
Next
Console.WriteLine(index)
Console.WriteLine(maxSum)
Console.Read()
End Sub
Here's my take on it using two different approaches. The first is a more traditional approach, while the second utilizes LINQ:
Sub Main()
Dim chunkSize As Integer = 8
Dim source As String =
"73167176531330624919225119674426574742355349194934" &
"96983520312774506326239578318016984801869478851843" &
"85861560789112949495459501737958331952853208805511" &
"12540698747158523863050715693290963295227443043557" &
"66896648950445244523161731856403098711121722383113" &
"62229893423380308135336276614282806444486645238749" &
"30358907296290491560440772390713810515859307960866" &
"70172427121883998797908792274921901699720888093776" &
"65727333001053367881220235421809751254540594752243" &
"52584907711670556013604839586446706324415722155397" &
"53697817977846174064955149290862569321978468622482" &
"83972241375657056057490261407972968652414535100474" &
"82166370484403199890008895243450658541227588666881" &
"16427171479924442928230863465674813919123162824586" &
"17866458359124566529476545682848912883142607690042" &
"24219022671055626321111109370544217506941658960408" &
"07198403850962455444362981230987879927244284909188" &
"84580156166097919133875499200524063689912560717606" &
"05886116467109405077541002256983155200055935729725" &
"71636269561882670428252483600823257530420752963450"
Dim strChunk As String
Dim strMaxChunk As String = ""
Dim curSum, MaxSum As Integer
Dim values() As Integer
For i As Integer = 0 To source.Length - chunkSize
strChunk = source.Substring(i, chunkSize)
values = Array.ConvertAll(strChunk.ToCharArray, Function(c) CInt(c.ToString()))
curSum = values.Sum
If curSum > MaxSum Then
MaxSum = curSum
strMaxChunk = strChunk
End If
Next
Console.WriteLine("Traditional")
Console.WriteLine("Max Sum = " & MaxSum & " from " & strMaxChunk)
Dim sums = From chunk In Enumerable.Range(0, source.Length - chunkSize).Select(Function(x) source.Substring(x, chunkSize))
Select chunk, sum = Array.ConvertAll(chunk.ToCharArray, Function(y) CInt(CStr(y))).Sum
Order By sum Descending
Dim linqResult = sums.First
Console.WriteLine("Linq")
Console.WriteLine("Max Sum = " & linqResult.sum & " from " & linqResult.chunk)
Console.ReadLine()
End Sub
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.
Trying to send three variables (startDate, endDate, division) from a chooser form to a report query. Sent the three variables through an doCommand.OpenReport command, then unpacked them in the Load event of the report. I'm not sure what to assign them to in the report to use them in the query.
In the form:
Private Sub btn_bud_sum_exp_div_Click()
Dim StrWhereCondition
Dim a As String
Dim b As String
Dim c As String
a = Me.txtStartDate.Value
b = Me.txtEndDate.Value
c = Me.lstDivision.Value
StrWhereCondition = a & "|" & b & "|" & c
'StrWhereCondition = "[accounting start date] = " & Me.txtStartDate.Text
DoCmd.OpenReport "FY15 Budget Line Sum - Expenditures - Div", , , StrWhereCondition
End Sub
In the Load event of the report:
Private Sub Report_Load()
Dim dtStartDate As Date
Dim dtEndDate As Date
Dim strDivision As String
If Not IsNull(Me.OpenArgs) Then
dtStartDate = parsetext(OpenArgs, 0)
dtEndDate = parsetext(OpenArgs, 1)
strDivision = parsetext(OpenArgs, 2)
End If
End Sub
In the report query:
SELECT
*
FROM
budget b
WHERE
(b.start_date between dtStartDate AND dtEndDate) AND d.division = strDivision
If you open the report with a filter string, you can delete all the OnLoad stuff of the report:
Private Sub btn_bud_sum_exp_div_Click()
Dim StartDate As String
Dim EndDate As String
Dim Division As String
Dim WhereCondition As String
StartDate = Format(Me!txtStartDate.Value, "yyyy\/mm\/dd")
EndDate = Format(Me!txtEndDate.Value, "yyyy\/mm\/dd")
Division = Me!lstDivision.Value
WhereCondition = "start_date between #" & StartDate & "# and #" & EndDate & "# and division = " & Division & ""
' or:
' WhereCondition = "[accounting start date] between #" & StartDate & "# and #" & EndDate & "# and division = " & Division & ""
' or, if division is text:
' WhereCondition = "start_date between #" & StartDate & "# and #" & EndDate & "# and division = '" & Division & "'"
DoCmd.OpenReport "FY15 Budget Line Sum - Expenditures - Div", , , WhereCondition
End Sub
I have designed a macro which should extract from a workbook database all employees who were hired between 2 Dates.
Unfortunatley I'm getting a error mesage when I run the query.
Error:
Data Type mismatch in criteria expression.
I don't know how to fix the issue.
My regional settings:
Short date: dd.MM.yyyy
Long date: dddd, d.MMMM.yyyy
First day of week: Monday
Here the code:
Public Sub HIREDATE()
Application.ScreenUpdating = False
Dim cnStr As String
Dim rs As ADODB.Recordset
Dim query As String
Dim fileName As String
Dim pom1 As String
Dim x As String, w, e, blad As String, opis As String
Set w = Application.FileDialog(msoFileDialogFilePicker)
With w
.AllowMultiSelect = False
If .Show = -1 Then
fileName = w.SelectedItems(1)
Else
Exit Sub
End If
End With
cnStr = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & fileName & ";" & _
"Extended Properties=Excel 12.0"
On Error GoTo Anuluj
x = InputBox("Wprowadz dwie daty od do oddzielając je przecinkiem -- Przykład 01.01.2015,01.05.2015")
strg = ""
k = Split(x, ",")
e = Application.CountA(k)
For m = LBound(k) To UBound(k)
If e = 1 Then
strg = strg & " [DEU1$].[Last Start Date] = '" & k(m) & "';"
Exit For
ElseIf e = 2 And e Mod 2 = 0 Then
strg = " [DEU1$].[Last Start Date] BETWEEN '" & CDate(k(m)) & "' AND '" & CDate(k(m + 1)) & "';"
Exit For
End If
Next m
On Error GoTo opiszblad
Set rs = New ADODB.Recordset
query = "SELECT [Emplid], [First Name]+ ' ' +[Last Name] From [DEU1$] WHERE" & strg
rs.Open query, cnStr, adOpenUnspecified, adLockUnspecified
Cells.Clear
Dim cell As Range, i As Long
With Range("A3").CurrentRegion
.Select
For i = 0 To rs.Fields.Count - 1
.Cells(1, i + 1).Value = rs.Fields(i).Name
Next i
Range("A4").CopyFromRecordset rs
.Cells.Select
.EntireColumn.AutoFit
End With
rs.Close
Application.ScreenUpdating = True
Exit Sub
Anuluj:
Exit Sub
opiszblad:
e = Err.Number
blad = Err.Source
opis = Err.Description
opisbledu = MsgBox(e & " " & blad & " " & opis, vbInformation, "Błąd")
Exit Sub
End Sub
You need properly formatted string expressions for your dates and to validate the user input:
If e = 1 And IsDate(k(m)) Then
strg = strg & " [DEU1$].[Last Start Date] = #" & Format(DateValue(k(m)), "yyyy\/mm\/dd") & "#;"
Exit For
ElseIf e = 2 And e Mod 2 = 0 And IsDate(k(m + 1)) Then
strg = " [DEU1$].[Last Start Date] BETWEEN #" & Format(DateValue(k(m)), "yyyy\/mm\/dd") & "# AND #" & Format(DateValue(k(m + 1)), "yyyy\/mm\/dd") & "#;"
Exit For
End If