(1) Table DB-Fiddle
CREATE TABLE logistics (
id int primary key,
Product VARCHAR(255),
insert_timestamp Date
);
INSERT INTO logistics
(id, product, insert_timestamp
)
VALUES
("1", "Product_A", "2020-02-24 18:15:48"),
("2", "Product_B", "2020-02-24 20:30:17"),
("3", "Product_C", "2020-02-24 23:54:58"),
("4", "Product_D", "2020-02-25 08:09:30"),
("5", "Product_E", "2020-02-25 10:17:15");
(2) VBA
Value in Cell B1 = 2020-02-24
Sub Get_Data()
Dim conn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim dateVar As Date
Set conn = New ADODB.Connection
conn.ConnectionString = "DRIVER={MySQL ODBC 5.1 Driver}; SERVER=localhost; DATABASE=bi; UID=username; PWD=password; OPTION=3"
conn.Open
strSQL = " SELECT " & _
" cID " & _
" FROM logistics " & _
" WHERE DATE(insert_timestamp) BETWEEN """ & Format(Sheet1.Range("B1").Value, "YYYY-MM-DD") & "00:00:00" & """ " & _
" AND """ & Format(Sheet1.Range("B1").Value, "YYYY-MM-DD") & "23:59:59" & """ " & _
" GROUP BY 1 "
Set rs = New ADODB.Recordset
rs.Open strSQL, conn, adOpenStatic
Sheet1.Range("A1").CopyFromRecordset rs
rs.Close
conn.Close
End Sub
I want to run a query within the VBA that uses the date in Cell B1 within the BETWEEN statement in the WHERE clause.
When I run this query outside of the VBA it works perfectly:
SELECT
Product
FROM logistics
WHERE DATE(insert_timestamp) BETWEEN "2020-02-24 00:00:00" AND "2020-02-24 23:59:59";
Once, I run it in the VBA it does not give me an error but it also does not give me any result.
I assume the issue is caused by my combination of the sql and the VBA in the strSQL.
How do I have to change the VBA to make it work?
Instead of formatting values like dates or strings into the SQL command, it is much better to use ADODB.Parameter - in that case the driver will do all the work for you. You don't have to take care about quotes around a string, formatting a date so that the database understands it correctly (which is highly depending on database, regional settings and so on). Plus it is a protection against SQL injection. Plus, the query optimizer can do it's job much better because it gets the same SQL command every time and remembers the execution plan.
Drawback: code get's slightly more complicated because you have to involve a ADODB.command object.
In your SQL statement, you put a simple ? at the place where you want to have a parameter. You just have to take care that the numbers and the position of ? and parameters matches.
Dim Conn As New ADODB.Connection, cmd As New ADODB.Command, param As ADODB.Parameter, rs As ADODB.Recordset
Conn.Open "<your connection string>"
Set cmd.ActiveConnection = Conn
cmd.CommandText = "SELECT cID FROM logistics WHERE DATE(insert_timestamp) BETWEEN ? AND ? GROUP BY 1"
Set param = cmd.CreateParameter(, adDate, adParamInput, , Date)
cmd.Parameters.Append param
Set param = cmd.CreateParameter(, adDate, adParamInput, , Date + 1)
cmd.Parameters.Append param
Set rs = cmd.Execute
Debug.Print rs.Fields(0).Name, rs(0).Value
P.S. Was a little lazy for the date handling, if you have data exactly at midnight, you would get too much data.
you are missing a space between the date and the time...
Open your VBE and debug print the formula to see the result (maker sure you have the immediate window [view menu / Immediate window).
Sub test()
Debug.Print Format(Sheet1.Range("B1").Value, "YYYY-MM-DD") & "23:59:59"
End Sub
result
2020-03-1123:59:59
Just can add the space after the DD as follow
Format(Sheet1.Range("B1").Value, "YYYY-MM-DD ") & "23:59:59"
I know you've accepted an answer and it's a perfectly good one. I'm just leaving this here as an alternative method which you might find useful in other cases too:
Dim date_to_use As String
date_to_use = Format(Sheet1.Range("B1").Value, "YYYY-MM-DD")
strSQl = " SELECT " & _
" cID " & _
" FROM logistics " & _
" WHERE DATE(insert_timestamp) BETWEEN '[date to use] 00:00:00'" & _
" AND '[date to use] 23:59:59'" & _
" GROUP BY 1 "
strSQl = Replace(strSQl, "[date to use]", date_to_use)
Storing the contents of B1 in this way before using it also allows you to apply other changes to it - just in case you wanted to clean it up further or reduce the chances of SQL injection being used..
Related
Picture this, I have a table in excel that is connected to power query that refreshes every minute, Im trying to use vba to export the live table to mysql , whenever the table in excel refreshes , the data also refreshes in the mySQL table, I need it to update the table where anything changes and also decrease rows if they no longer exist in the excel table, whenever the table refresh and update the new values to the SQL table
The code I have here is of a Insert and delete system, which takes time to load about 3 minutes depending on the data in the table, I want to use the UPDATE statement in my code instead of deleting and inserting the whole
is it possible, can someone please reply as an answer with the update statement
How do I Edit That In My Code?
My SQL Table Has
COL 1,
COl 2,
COL 3,
COL 4,
COL 5,
COL 6,
COL 7
As the column Names,same applies to the table in excel, it has 7 columns too
Dim oConn As ADODB.Connection
Dim rs As ADODB.Recordset
'remove dangerous characters
Function esc(txt As String)
esc = Trim(Replace(txt, "'", "\'"))
End Function
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Set rs = New ADODB.Recordset
Set oConn = New ADODB.Connection
oConn.Open "DRIVER={MySQL ODBC 8.0 ANSI Driver};" & _
"SERVER=localhost;" & _
"DATABASE=engine;" & _
"USER=root;" & _
"PASSWORD=;" & _
"Option=3"
Dim del As String
del = "DELETE FROM `feed`"
rs.Open del, oConn ',adOpenDynamic, adLockOptimistic
'number of rows with records. testingupload is the sheetname.
Dim height As Integer
height = Worksheets("Feed").UsedRange.Rows.Count
'insert data into SQL table. testingupload is the sheetname.
With Worksheets("Feed")
Dim rowtable As Integer
Dim strSQL As String
For rowtable = 2 To height
strSQL = "INSERT INTO `feed` (`COL 1`, `COL 2`, `COL 3`, `COL 4`, `COL 5`, `COL 6`, `COL 7`) " & _
"VALUES ('" & esc(Trim(.Cells(rowtable, 1).Value)) & "', '" & _
esc(Trim(.Cells(rowtable, 2).Value)) & "', '" & _
esc(Trim(.Cells(rowtable, 3).Value)) & "', '" & _
esc(Trim(.Cells(rowtable, 4).Value)) & "', '" & _
esc(Trim(.Cells(rowtable, 5).Value)) & "', '" & _
esc(Trim(.Cells(rowtable, 6).Value)) & "', '" & _
esc(Trim(.Cells(rowtable, 7).Value)) & "')"
rs.Open strSQL, oConn ',adOpenDynamic, adLockOptimistic
Next rowtable
End With
End Sub
So, as said in the comments, my understanding is that you would like to copy all the data from the excel table into the MySql Table. As you did not give any hint how to identify a single row by a key I assume that one just can delete the data from the MySql table and then insert all the data from the excel sheet into the MySql table.
Let
Dim cn As ADODB.Connection
' your code to establish the connection
be the connection to the MySql database then you can delete the data quite simple
Dim sSQL As String
sSQL = "DELETE * FROM tbl1"
cn.Execute sSQL
tbl1 is the name of the table in question from the MySql database
After you have deleted the data from the MySql table you just insert all data from the excel table into the MySql table
sSQL = " INSERT INTO tbl1 SELECT * FROM [Excel 12.0;HDR=YES;DATABASE=" _
& ThisWorkbook.FullName & "].[Sheet1$A1:B5]"
cn.Execute sSQL
The tricky part here is left for you as you know in which excel sheet the data is stored and what range it covers. That means you probably have to adjust the sheetname Sheet1 and the range A1:B5. Please do not remove the $ beetween the sheet name and the range. It is needed for the code to work.
As you have seven columns I guess the range will be similar to
" .... [Sheet1$A1:G" & Height & "]"
where height is the number of the rows (see your code above).
Your code might look like that at the end
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim Cn As ADODB.Connection
Set cn = New ADODB.Connection
cn.Open "DRIVER={MySQL ODBC 8.0 ANSI Driver};" & _
"SERVER=localhost;" & _
"DATABASE=engine;" & _
"USER=root;" & _
"PASSWORD=;" & _
"Option=3"
'number of rows with records. testingupload is the sheetname.
Dim height As Integer
height = Worksheets("Feed").UsedRange.Rows.Count
Dim sSQL As String
sSQL = "DELETE * FROM tbl1"
cn.Execute sSQL
sSQL = " INSERT INTO tbl1 SELECT * FROM [Excel 12.0;HDR=YES;DATABASE=" _
& ThisWorkbook.FullName & "].[Sheet1$A1:G" & height & "]"
cn.Execute sSQL
cn.Close
End Sub
To give a brief summary of the objective of this macro, I am trying to get the sum of cash between certain dates based on a set of parameters. I keep getting an error in VBA when I try to run a SQL query with a date. I'm not sure what the issue is but I think it's related to how I have the date formatted. I have tried running it multiple ways but keep getting a syntax error, whether it be related to 'a', '#', or 'table'.
Here's the query I'm using. Any help would be greatly appreciated.
Sub GetCashBalance()
Dim cn As New ADODB.Connection
Dim rs As ADODB.Recordset
Dim SQL As String
Dim StartDate As String
Dim EndDate As String
StartDate = InputBox("Enter Start Date in mm/dd/yy format.")
EndDate = InputBox("Enter End Date in mm/dd/yy format.")
SQL = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=True;Initial Catalog=master;Data Source=SERVER\ODS"
Set cn = New ADODB.Connection
Set rs = New ADODB.Recordset
cn.Open SQL
Set rs = cn.Execute("SELECT SUM(a.CASH)" & _
"FROM CUSTOMER_DATA.dbo.TRANSACTION_HISTORY a" & _
"LEFT JOIN CUSTOMER_DATA.dbo.DAILY_TRANSACTION b" & _
"ON a.T01_KEY = b.T01_KEY" & _
"WHERE PROC_DATE BETWEEN #StartDate# AND #EndDate#" & _
"AND a.CODE NOT IN ('22','23','M','2-L','36-R')" & _
"AND isnull(a.DESCRIPTION, '') NOT IN ('01','02','03','0DO1','0NF2');")
If Not rs.EOF Then
Sheets(7).Range("A40").CopyFromRecordset rs
rs.Close
Else
MsgBox "Error", vbCritical
End If
cn.Close
End Sub
Set rs = cn.Execute("SELECT SUM(a.CASH)" & _
"FROM CUSTOMER_DATA.dbo.TRANSACTION_HISTORY a" & _
"LEFT JOIN CUSTOMER_DATA.dbo.DAILY_TRANSACTION b" & _
"ON a.T01_KEY = b.T01_KEY" & _
"WHERE PROC_DATE BETWEEN '" & StartDate & "' AND '" & EndDate & _
"# AND a.CODE NOT IN ('22','23','M','2-L','36-R')" & _
"AND isnull(a.DESCRIPTION, '') NOT IN ('01','02','03','0DO1','0NF2');")
Take a look at below piece, that should be changed
BETWEEN '" & StartDate & "' AND '" & EndDate & _
"' AND ....
I think it is better to use ADODB.Command and Parameters instead of doing a concatenation in the sql query.
Error: "Run-time error '3061' Too few parameters. Expected 2.
I wrote this simple function that returns the remaining percentage calculated for number of records changed. It is supposed to occur when the user updates the field called 'percentage' I am certain the code below should work, but obviously something is wrong. It occurs on the line:
Set rs = db.OpenRecordset("SELECT Tier1, [Percentage], Tier3 AS Battalion, Month " _
& "FROM tbl_CustomPercent " _
& "WHERE (((Tier1)=[Forms]![frmEntry]![cmbImport_T1]) AND ((Month)=[Forms]![frmEntry]![cmbMonth]));", dbOpenSnapshot)
I wonder how it could fail when the very same query is what populates the 'record source' for the form with the 'percentage' textbox.
Function RemainingPercentAvailable() As String
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strSQL As String
Set db = CurrentDb
Set rs = db.OpenRecordset("SELECT Tier1, [Percentage], Tier3 AS Battalion, Month " _
& "FROM tbl_CustomPercent " _
& "WHERE (((Tier1)=[Forms]![frmEntry]![cmbImport_T1]) AND ((Month)=[Forms]![frmEntry]![cmbMonth]));", dbOpenSnapshot)
Dim CurrentTotal As Single
CurrentTotal = 0
If Not (rs.EOF And rs.BOF) Then
rs.MoveFirst
Do Until rs.EOF = True
CurrentTotal = CurrentTotal + rs!Percentage
rs.MoveNext
Loop
End If
RemainingPercentAvailable = "Remaing available: " & Format(1 - CurrentTotal, "0.000%")
Set rs = Nothing
Set db = Nothing
End Function
Adapt your code to use the SELECT statement with a QueryDef, supply values for the parameters, and then open the recordset from the QueryDef.
Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Dim rs As DAO.Recordset
Dim strSQL As String
strSQL = "SELECT Tier1, [Percentage], Tier3 AS Battalion, [Month] " _
& "FROM tbl_CustomPercent " _
& "WHERE (((Tier1)=[Forms]![frmEntry]![cmbImport_T1]) AND (([Month])=[Forms]![frmEntry]![cmbMonth]));"
Set db = CurrentDb
Set qdf = db.CreateQueryDef(vbNullString, strSQL )
' supply values for the 2 parameters ...
qdf.Parameters(0).Value = Eval(qdf.Parameters(0).Name)
qdf.Parameters(1).Value = Eval(qdf.Parameters(1).Name)
Set rs = qdf.OpenRecordset
Note: Month is a reserved word. Although that name apparently caused no problems before, I enclosed it in square brackets so the db engine can not confuse the field name with the Month function. It may be an unneeded precaution here, but it's difficult to predict exactly when reserved words will create problems. Actually, it's better to avoid them entirely if possible.
This one is calling a query directly in a DAO.Recordset and it works just fine.
Note the same 'Set rs = db.OpenRecordset(strSQL, dbOpenDynaset) This is a parameter SQL as well.
The only difference is with this one is that I DIDN'T need to move through and analyze the recordset - but the error occurs on the 'Set rs = " line, so I wasn't able to get further anyway.
Dim rs As DAO.Recordset
Dim db As DAO.Database
Dim strSQL As String
strSQL = "SELECT Sum(tbl_SP.AFP) AS AFP_TOTAL, tbl_SP.T1_UNIT " _
& "FROM tbl_SP " _
& "GROUP BY tbl_SP.T1_UNIT " _
& "HAVING (((tbl_SP.T1_UNIT)='" & strUnit & "'));"
Set db = CurrentDb
Set rs = db.OpenRecordset(strSQL, dbOpenDynaset)
AFP_Total = rs!AFP_Total
There is an even simpler way to calculate the total percentage.
Instead of looping through the records, you can use the DSum() function.
Note that DSum will return Null if there are no records, so you need to wrap it in Nz().
Just for fun, here is your function but written as one single statement:
Function RemainingPercentAvailable() As String
RemainingPercentAvailable = "Remaining available: " & Format(1 - _
Nz(DSum("Percentage", _
"tbl_CustomPercent", _
"Tier1 = " & QString(cmbImport_T1) & _
" AND [Month] = " & QString(cmbMonth))) _
, "0.000%")
End Function
I don't recommend building a temporary parameterized query in VBA, because it makes the code too complicated. And slower. I prefer to build "pure" SQL that will run directly in the db engine without any callbacks to Access. I'm assuming that your function is defined in the frmEntry form, and that cmbImport_T1 and cmbMonth are string fields. If they are numeric, omit qString().
Here is my version of your function. It handles the empty-recordset case correctly.
Function RemainingPercentAvailable() As String
Dim CurrentTotal As Double, q As String
q = "SELECT Percentage" & _
" FROM tbl_CustomPercent" & _
" WHERE Tier1 = " & QString(cmbImport_T1) & _
" AND [Month] = " & QString(cmbMonth)
CurrentTotal = 0
With CurrentDb.OpenRecordset(q)
While Not .EOF
CurrentTotal = CurrentTotal + .Fields("Percentage")
.MoveNext
Wend
End With
RemainingPercentAvailable = "Remaining available: " & _
Format(1 - CurrentTotal, "0.000%")
End Function
' Return string S quoted, with quotes escaped, for building SQL.
Public Function QString(ByVal S As String) As String
QString = "'" & Replace(S, "'", "''") & "'"
End Function
I am trying to create a change log anytime a field is changed. I want it to record the property, the manager, and the date it was changed. I looked up INSERT INTO and followed the directions and came up with this code, but I get an error.
Private Sub Manager_AfterUpdate()
INSERT INTO tbl_ManagerChangeLog (Property, NewMan, [Date Change])
VALUES (Me.ID, Me.Manager, DATE())
End Sub
There error I get reads, "Compile Error: Expected: End of statement"
Any help is appreciated.
Here is final code that worked for me. Thank you for all of the help.
Private Sub Manager_Change()
Dim dbs As Database, PropID As Integer, ManNam As String, ChangeDate As Date
Set dbs = CurrentDb()
PropID = Me.ID
ManNam = Me.Manager
ChangeDate = Date
dbs.Execute " INSERT INTO tbl_ManagerChangeLog " & "(Property, NewMan, DateChange)VALUES " & "(" & PropID & ", " & ManNam & ", #" & ChangeDate & "#);"
End Sub
You must run a SQL query using Execute funcion from currentDb object, and build the query values concatenating values:
Private Sub Manager_AfterUpdate()
Dim sSQL as String
sSQL = "INSERT INTO tbl_ManagerChangeLog (Property, NewMan, [Date Change]) " & _
"VALUES (" & Me.ID & ",'" & Me.Manager "'," & _
"#" & format(DATE(),"YYYY-MM-DD HH:NN:SS") & "#)"
currentDB.Execute sSQL
End Sub
Try the following VBA to run a sql query.
Private Sub Manager_AfterUpdate()
Dim strSql As String , Db As dao.Database
strSql = "INSERT INTO tbl_ManagerChangeLog (Property, NewMan, [Date Change]) VALUES (Me.ID, Me.Manager, DATE());"
'Use Current Database
Set Db = CurrentDb()
'Run the SQL Query
Db.Execute strSql
End Sub
I am trying to access certain lines from my SQL database from MSAccess and I keep getting an Invalid Argument Error on this line:
Set rs = CurrentDb.OpenRecordset("SELECT TimeID " & _
"FROM tblLunchTime " & _
"WHERE ProductionID = prodSelect AND EndTime is NULL AND StartTime < dateAdd('h', 3, NOW())", [dbSeeChanges])
Is something not right in this?
Private Sub cmdClockEnd_Click()
'Check if a group has been selected.
If frmChoice.value = 0 Then
MsgBox "Please select a production line."
End
End If
'Setup form for user input.
lblEnd.Visible = True
'Save end of lunch value.
lblEnd.Caption = Format(Now, "MMM/DD/YY hh:mm:ss AMPM")
'Declare database variables.
Dim dbName As DAO.Database
Dim strValuesQuery As String
Dim rs As DAO.Recordset
Dim prodSelect As String
Dim sSQL As String
Dim timeValue As String
Set dbName = CurrentDb
'Get values of Production Line.
If frmChoice.value = 1 Then
prodSelect = "L2"
ElseIf frmChoice.value = 2 Then
prodSelect = "L3"
End If
'Get the last TimeID with the following parameters.
sSQL = "SELECT TimeID " & _
"FROM tblLunchTime " & _
"WHERE ProductionID = prodSelect AND EndTime is NULL AND StartTime < #" & DateAdd("h", 3, Now()) & "#"
Set rs = dbName.OpenRecordset(sSQL, dbSeeChanges)
strValuesQuery = _
"UPDATE tblLunchTime " & _
"SET EndTime = '" & Now & "'" & _
"WHERE TimeID = " & rs![TimeID] & " "
'Turn warning messages off.
DoCmd.SetWarnings False
'Execute Query.
DoCmd.RunSQL strValuesQuery
'Turn warning messages back on.
DoCmd.SetWarnings True
End Sub
You need to put prodSelect outside the quotes:
"WHERE ProductionID = " & prodSelect & " AND ...
It is nearly always best to say:
sSQL="SELECT TimeID " & _
"FROM tblLunchTime " & _
"WHERE ProductionID = " & prodSelect & _
" AND EndTime is NULL AND StartTime < dateAdd('h', 3, NOW())"
''Debug.print sSQL
Set rs = CurrentDb.OpenRecordset(sSQL)
You can see the advantage in the use of Debug.Print.
AHA prodSelect is text! You need quotes!
sSQL="SELECT TimeID " & _
"FROM tblLunchTime " & _
"WHERE ProductionID = '" & prodSelect & _
"' AND EndTime is NULL AND StartTime < dateAdd('h', 3, NOW())"
There appears to be confusion about tblLunchTime ... whether it is a native Jet/ACE table or a link to a table in another database. Please show us the output from this command:
Debug.Print CurrentDb.TableDefs("tblLunchTime").Connect
You can paste that line into the Immediate Window and press the enter key to display the response. (You can open the Immediate Window with CTRL+g keystroke combination.)
Just in case the response starts with "ODBC", suggest you try this line in your code:
Set rs = CurrentDb.OpenRecordset(sSQL, dbOpenDynaset, dbSeeChanges)
Update: Now that you're past that hurdle, suggest you change your approach with the UPDATE statement. Don't turn off warnings; try something like this instead:
'Execute Query. '
CurrentDb.Execute strValuesQuery, dbFailOnError
And add an error handler to deal with any errors captured by dbFailOnError.
I think I would do the date criterion concatenation client-side, too, since it's one more thing that could go wrong:
"...StartTime < #" & DateAdd("h", 3, Now()) & "#"
I don't know that SQL Server doesn't have DateAdd() and Now() function nor that they don't behave exactly the same as in Access, but I wouldn't take the chance -- I'd do this calculation on the client instead of handing it off to the server.