I am currently trying to write a query in VBA to obtain data in Access. For the string SQL, everything works except for the WHERE clause and I am not sure how to write it syntax wise. I am getting a
Run-Time error 3075 - Syntax error (missing operator) in query
expression.
Below is my code:
Sub ImportFromAccess_Size()
database_file_path = Range("Database_File_Path").Value
Dim DbLoc As String
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim xlbook As Workbook
Dim xlsheet As Worksheet
Dim recCount As Long
Dim SQL As String
DbLoc = database_file_path
Application.ScreenUpdating = False
Set xlbook = ActiveWorkbook
Set xlsheet = Sheets("Simulation Input Data")
Application.StatusBar = "Connecting to an external database..."
'Application.Cursor = xlWait
tool_file_path = Range("Tool_File_Path").Value
database_file_path = Range("Database_File_Path").Value
size_system = Range("Size_System").Value
Set db = OpenDatabase(DbLoc)
'Set db = OpenDatabase(database_file_path)
SQL = "SELECT SCHED_SURGERY_DATETIME "
SQL = SQL & "FROM Raw_Data "
SQL = SQL & "ORDER BY SCHED_SURGERY_DATETIME "
SQL = SQL & "WHERE [PROCEDURE_NM_WID] = (" & size_system & ")"
Sheets("Simulation Input Data").Activate
Set rs = db.OpenRecordset(SQL, dbOpenSnapshot)
xlsheet.Range("A2").CopyFromRecordset rs
End Sub
Put the text string criteria in single quotes (aka 'ticks')
SQL = "SELECT [SCHED_SURGERY_DATETIME] "
SQL = SQL & "FROM Raw_Data "
SQL = SQL & "WHERE [PROCEDURE_NM_WID] = '" & size_system & "' "
SQL = SQL & "ORDER BY [SCHED_SURGERY_DATETIME];"
Related
I have a list of account ID in column A. The range of that column is dynamic. How do I write a module that will take those values and use them in an SQL IN statement. Below is my attempt at doing this. I pieced together multiple scripts I found so sorry if it is a mess.
Sub ConnectSqlServer()
Dim conn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim sConnString As String
Dim wbBook As Workbook
Dim wsSheet As Worksheet
Dim lastrow As Long
Dim sl As Long
With wsSheet
lastrow = .Range("A" & .Rows.Count).End(xlUp).Row
End With
' Appending the values to a single variable
For i = 1 To lastrow
s1 = s1 & "'" & Val(wsSheet.Cells(i, 1)) & "'" & ","
Next
' Variable which could be used in IN command
If lastrow > 0 Then
s1 = Mid(s1, 1, Len(s1) - 1)
s1 = "(" & s1 & ")"
Else
Exit Sub
End If
' ' Create the connection string.
sConnString = "Driver={ODBC Driver 13 for SQL Server}; Server=snapshot;" & _
"Database=salesforce_replica;" & _
"Trusted_Connection=yes;"
' Create the Connection and Recordset objects.
Set conn = New ADODB.Connection
Set rs = New ADODB.Recordset
' Open the connection and execute.
conn.Open sConnString
Set rs = conn.Execute("SELECT * FROM dbo.account where Account_ID_18__c = " & s1;)
' Check we have data.
If Not rs.EOF Then
' Transfer result.
Sheets(1).Range("A1").CopyFromRecordset rs
' Close the recordset
rs.Close
Else
MsgBox "Error: No records returned.", vbCritical
End If
' Clean up
If CBool(conn.State And adStateOpen) Then conn.Close
Set conn = Nothing
Set rs = Nothing
End Sub
My goal is to figure out how to take a dynamic range of values and use them within an SQL Where statement.
Try something like this:
Sub ConnectSqlServer()
Dim conn As ADODB.Connection, rs As ADODB.Recordset
Dim sConnString As String
Dim wb As Workbook, ws As Worksheet, rngIds As Range, sql As String, inList As String
Set wb = ThisWorkbook
Set ws = wb.Sheets("list")
Set rngIds = ws.Range("A1:A" & ws.Cells(Rows.Count, "A").End(xlUp).Row)
inList = InClause(rngIds)
If Len(inList) = 0 Then
MsgBox "No id values!"
Exit Sub 'nothing to query...
End If
sConnString = "Driver={ODBC Driver 13 for SQL Server}; Server=snapshot;" & _
"Database=salesforce_replica;" & _
"Trusted_Connection=yes;"
Set conn = New ADODB.Connection
conn.Open sConnString
Set rs = conn.Execute("SELECT * FROM dbo.account where Account_ID_18__c in " & inList)
If Not rs.EOF Then
wb.Sheets(1).Range("A1").CopyFromRecordset rs
Else
MsgBox "Error: No records returned.", vbCritical
End If
rs.Close
conn.Close
End Sub
'Generate a SQL "in" list from distinct values in range `rng`
' Add single quotes around values unless `IsNumeric` is True
' Note if `rng` has too many values you may exceed your max. SQL query size!
Function InClause(rng As Range, Optional IsNumeric As Boolean = False) As String
Dim c As Range, dict As Object, arr, qt As String, v
Set dict = CreateObject("scripting.dictionary")
For Each c In rng.Cells
v = Trim(c.Value)
If Len(v) > 0 Then dict(v) = 1
Next c
If Not IsNumeric Then qt = "'"
If dict.Count > 0 Then
InClause = "(" & qt & Join(dict.keys, qt & "," & qt) & qt & ")"
End If
End Function
I want to find the sum of records from different tables and insert the output in a new column, when I run the code it show me the error:
"The query cannot be completed. Either the size of the query result is
larger than the maximum size of the database (2GB) or there is not enough
temporary storage space on the disk to store the query result"
And it highlight the line
STD.Open sql, cnn, adOpenStatic
My code is the following
Option Compare Database
Option Explicit
Public cnn As New ADODB.Connection
Public db As DAO.Database
Public Sub SMain()
Set db = Access.Application.CurrentDb
Set cnn = CurrentProject.Connection
Get_Value
End Sub
Private Sub Get_Value()
Dim sql As String
Dim STD As New ADODB.Recordset
Dim ODR As DAO.Recordset
Set ODR = db.OpenRecordset("Total_tbl")
Do Until ODR.EOF
DoEvents
sql = "SELECT SUM(MONT_VOL.tot_n* STD_tbl.factor_n)AS TOTAL_N FROM MONT_VOL " & _
" INNER JOIN (STD_tbl INNER JOIN Total_tbl ON STD_tbl.AREA =Total_tbl.AREA_1" & _
" AND STD_tbl.AID = Total_tbl.AID)" & _
" ON MONT_VOL.BID = STD_tbl.BLOCK" & _
" WHERE MONT_VOL.BDATE = Total_tbl.Adate" & _
" GROUP BY MONT_VOL.BID"
STD.Open sql, cnn, adOpenStatic
If STD.RecordCount <> 0 Then
ODR.Edit
ODR!New_Col= STD!TOTAL_N
ODR.Update
End If
STD.Close
ODR.MoveNext
Loop
End Sub
What mistake I did?
And am I calling the output correctly on
ODR!New_Col= STD!TOTAL_N
If the query is too big (which the error message indicates), then let's split it into smaller chunks. This is only properly possible in MySQL, Access doesn't support LIMIT or OFFSET, workarounds are messy, especially for totals queries
I'm making a few assumptions here:
All relevant tables are stored within the same MySQL database
Your tables have valid connection strings that can be used for ADO
Note that executing the query in MySQL alone is probably enough to fix this error.
Private Sub Get_Value()
Dim sql As String
Dim STD As New ADODB.Recordset
Dim ODR As DAO.Recordset
Set ODR = db.OpenRecordset("Total_tbl")
'Create a new ADODB connection that's directly to MySQL, and doesn't use Access
Dim adoConn2 As ADODB.Connection
adoConn2.ConnectionString = CurrentDb.TableDefs("MONT_VOL").Connect
adoConn2.Open
'Initialize variables used for pagination
Dim RecordCount As Integer
Dim PageSize As Integer
Dim Offset As Integer
Offset = 0
RecordCount = 1
PageSize = 100
Do Until ODR.EOF
DoEvents
While RecordCount <> 0
sql = "SELECT SUM(MONT_VOL.tot_n* STD_tbl.factor_n)AS TOTAL_N FROM MONT_VOL " & _
" INNER JOIN (STD_tbl INNER JOIN Total_tbl ON STD_tbl.AREA =Total_tbl.AREA_1" & _
" AND STD_tbl.AID = Total_tbl.AID)" & _
" ON MONT_VOL.BID = STD_tbl.BLOCK" & _
" WHERE MONT_VOL.BDATE = Total_tbl.Adate" & _
" GROUP BY MONT_VOL.BID" & _
" LIMIT " & Offset & "," & PageSize
STD.Open sql, adoConn2, adOpenStatic
RecordCount = STD.RecordCount
If STD.RecordCount <> 0 Then
ODR.Edit
ODR!New_Col = STD!TOTAL_N
ODR.Update
End If
STD.Close
Offset = Offset + PageSize
Wend
ODR.MoveNext
Loop
adoConn2.Close
End Sub
I got en error while opening my form in access.
This code should be executed with the "OnOpen event" for that form.
But im getting an error in my script.
Dim ThisDB As DAO.Database
Set ThisDB = CurrentDb
Dim d As DAO.Recordset
Dim q As String
q = "SELECT [tbl-apartner].[EMail] FROM [tbl-apartner] WHERE [tbl-apartner].[SID] = " & sid2 'sql query
Set d = ThisDB.OpenRecordset(q, dbOpenDynaset)
Dim Result As String
Result = ""
If d.EOF = False Or d.BOF = False Then 'if-else clause
d.MoveFirst
Do While Not d.EOF
If Result <> "" Then Result = Result & "; "
Result = Result & d!EMail
d.MoveNext
Loop
End If
d.Close
The faulty line is:
Set d = ThisDB.OpenRecordset(q, dbOpenDynaset)
I solved the problem.
The Line
q = "SELECT [tbl-apartner].[EMail] FROM [tbl-apartner] WHERE [tbl-apartner].[SID] = " & sid2
was not correct.
q = "SELECT [tbl-apartner].[EMail] FROM [tbl-apartner] WHERE [tbl-apartner].[SID] = " & "'" & sid2 & "'"
The difference is: = " & "'" & sid2 & "'"
I am writing a macro by which I want to delete few names in column A of sheet 2 from the server table called login.
Database name is "my_db" and table name is login. I calling connection to connect to the server databse. Following is the complete code :-
Dim cnt As ADODB.Connection
Dim rst As ADODB.Recordset
Dim Sql As String
Sub Button1_Click()
Dim Ws As Worksheet
Dim Var As String
Dim i As Integer
i = 1
Set Ws = Worksheets("Sheet2")
Var = "login"
Sql = "name"
Call Connection
Do
Sql = " Delete From " & " " & Var & "" & " Where name" = "Ws.Cells(i, 1)"
Call Connection
i = i + 1
Loop Until Ws.Cells(i, 1) = ""
MsgBox "All entries deleted from login table"
End Sub
Dim strUserName As String
Dim strPassword As String
Dim ConnectString As String
Set cnt = New ADODB.Connection
strServerName = "localhost"
strDatabaseName = "my_db"
strUserName = "root"
strPassword = "root1"
ConnectString = "DRIVER={MySQL ODBC 5.1 Driver};" & _
"SERVER=" & strServerName & _
";DATABASE=" & strDatabaseName & ";" & _
"USER=" & strUserName & _
";PASSWORD=" & strPassword & _
";OPTION=3;"
With cnt
.CursorLocation = adUseClient
.Open ConnectString
.CommandTimeout = 0
Set rst = .Execute(Sql)
End With
'rst.Close
'cnt.Close
Set rst = Nothing
Set cnt = Nothing
End Sub
But the entries are not getting deleted. There is an error in SQL syntax, can anyone help me with the sql syntax ?
Sql = "delete From " & Var & " where name ='" & Ws.Cells(i, 1).Value & "'"
but it would be better to open the connection only once, run all the deletes, and then close the connection.
Also you don't need a recordset here (since you're not returning any records), so you can ignore the return value from cnt.Execute
Since you pasted the code only partially, I can only guess.
Do
Sql = " Delete From " & Var & " Where name" = "Ws.Cells(i, 1)"
Call Connection (Sql)
i = i + 1
Loop Until Ws.Cells(i, 1) = ""
Clean up your query. And more important pass it as a parameter to the connection.
I have the following code:
Public Function BuildSQL(stQueryName As String, stWhereClause As String) As String
On Error GoTo Err_BuildSQL
Dim SQLcmd As String
Dim intPos As Integer
Dim db As Database
Dim qryOrig As QueryDef
Set db = CurrentDb()
Set qryOrig = db.QueryDefs(stQueryName)
SQLcmd = qryOrig.SQL
intPos = InStr(SQLcmd, "WHERE")
If intPos > 0 Then
SQLcmd = Left(SQLcmd, intPos - 1)
End If
intPos = InStr(SQLcmd, ";")
If intPos > 0 Then
SQLcmd = Left(SQLcmd, intPos - 1)
End If
If Not (stWhereClause = "") Then
SQLcmd = Trim(SQLcmd) & " WHERE " & stWhereClause & ";"
Else
SQLcmd = Trim(SQLcmd) & ";"
End If
BuildSQL = SQLcmd
Exit_BuildSQL:
Set qryOrig = Nothing
Set db = Nothing
Exit Function
Err_BuildSQL:
MsgBox Err.Description
Resume Exit_BuildSQL
End Function
Private Sub SandBox_Click()
On Error GoTo Err_SandBox_Click
Dim db As Database
Dim rs As Recordset
Dim stSQL As String
Dim stFrmName As String
Dim stQryName As String
Dim stSQLWhere As String
Dim stIDList As String
stFrmName = "Libri"
stQryName = "Libri_All_Query"
'Define WHERE clause
stSQLWhere = ""
If Not (IsNull([Forms]![Libreria]![Editore]) Or [Forms]![Libreria]![Editore] = "") Then
stSQLWhere = stSQLWhere & "Libri_Editori.Editore = '" & [Forms]![Libreria]![Editore] & "'"
End If
If Not (IsNull([Forms]![Libreria]![CognomeAutore]) Or [Forms]![Libreria]![CognomeAutore] = "") Then
If (stSQLWhere = "") Then
stSQLWhere = stSQLWhere & "Autori.Cognome = '" & [Forms]![Libreria]![CognomeAutore] & "'"
Else
stSQLWhere = stSQLWhere & " AND Autori.Cognome = '" & [Forms]![Libreria]![CognomeAutore] & "'"
End If
End If
'Here several more fields of the search form will be checked and added
stSQL = BuildSQL(stQryName, stSQLWhere)
'*** Code in question!
Set db = CurrentDb()
Set rs = db.OpenRecordset(stSQL)
If Not (rs.EOF And rs.BOF) Then
stIDList = "("
rs.MoveFirst
Do Until rs.EOF = True
If (stIDList = "(") Then
stIDList = stIDList & rs.Fields(0)
Else
stIDList = stIDList & ", " & rs.Fields(0)
End If
rs.MoveNext
Loop
stIDList = stIDList & ")"
Else
Err.Description = "Errore! Recordset vuoto."
Resume Err_SandBox_Click
End If
DoCmd.OpenForm stFrmName, , , , acFormReadOnly
Access.Forms(stFrmName).RecordSource = "SELECT * FROM Libri WHERE Libri.ID IN " & stIDList
'**** End code in question
Exit_SandBox_Click:
Set db = Nothing
Set rs = Nothing
Exit Sub
Err_SandBox_Click:
MsgBox Err.Description
Resume Exit_SandBox_Click
End Sub
This code works as I want but "looks" slow even with a test DB with only a few records in each table.
I believe the time is spent (how can I check if this is true?) in the loop between comments.
Is there a more basic, obvious and efficient way to filter the form than creating a recordset and looping through it as I am doing?
The form "Libri" is a big one with several subform to be able to see all the data of a Book.
The query "Libri_All_Query" is a join of almost all tables in the DB and the code shown is executed from a form where I plan to add all possible search fields.
Forms have a filter property:
stWhereClause = "Title Like '" & Me.txtSearch & "*'"
Me.Filter = stWhereClause
Me.FilterOn = True
The filter should be constructed in a similar way to a WHERE statement. There are some limitations compared with Where. You may wish to check with DCount that records will be returned.
EDIT
If you want a set of records where a subform contains only certain records, you need something on these lines:
SELECT b.Title
FROM Books b
WHERE b.ID IN (
SELECT j.BookID FROM BooksAuthorJunction j
INNER JOIN Authors a ON j.AuthorID = a.ID
WHERE a.Author Like "Arn*")
There are advantages in building more that one form, books as a main form and authors as a subform, then authors as a main form and books as a subform. It is often easier on the user.