Syntax error in dynamic SQL string - sql

Please help to fix the following syntax error with Like statement. The query works with = but I need to use Like to search in the AAchange field. I think the problem is here "WHERE [AAchange] LIKE '" & "%" & _
but I'm not sure how to correct this syntax. Please see the code below:
Sub ColorNewVariant()
Dim PolicyNum As Variant
Dim bFound As Boolean
Dim cnn As ADODB.Connection 'dim the ADO collection class
Dim rs As ADODB.Recordset 'dim the ADO recordset class
Dim dbPath As String
Dim strSQL As String
Dim r As Range, cell As Range
Dim LastRow As Long
LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
Application.EnableEvents = False
Set r = ThisWorkbook.ActiveSheet.Range("G3:G" & LastRow)
For Each cell In r
If cell.Value <> "" Then
PolicyNum = cell.Value
dbPath = PATH_MAIN & "\Report\MDL_IonTorrent.accdb"
Set cnn = New ADODB.Connection ' Initialise the collection class variable
'Connection class is equipped with a -method- Named Open
'--4 aguments-- ConnectionString, UserID, Password, Options
'ConnectionString formula--Key1=Value1;Key2=Value2;Key_n=Value_n;
cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dbPath
strSQL = "SELECT [AAchange] " & _
"FROM [MDL_Table1] " & _
"WHERE [AAchange] LIKE '" & "%" & _
Replace(PolicyNum, """", """""", , , vbTextCompare) & _
""""
'Create the ADODB recordset object.
Set rs = New ADODB.Recordset 'assign memory to the recordset
'ConnectionString Open '--5 aguments--
'Source, ActiveConnection, CursorType, LockType, Options
rs.Open strSQL, cnn
bFound = Not rs.EOF
'Check if the recordset is empty.
'Close the recordet and the connection.
rs.Close
cnn.Close
'clear memory
Set rs = Nothing
Set cnn = Nothing
'Enable the screen.
If bFound Then
'MsgBox "Record exists."
Else
'MsgBox "Record not found."
'cell.Interior.ColorIndex = 8
cell.Interior.Color = RGB(255, 217, 218)
'cell.ClearComments
'cell.AddComment "New Variant"
'Fits shape around text
'cell.Comment.Shape.TextFrame.AutoSize = True
End If
End If
Next cell
Application.EnableEvents = True
End Sub

Change the quoting in your query's WHERE clause.
If you use single quotes to start and end the string value you build, you needn't bother with Replace() of double quotes within the PolicyNum value. That should make this task simpler and less confusing ...
strSQL = "SELECT [AAchange] " & _
"FROM [MDL_Table1] " & _
"WHERE [AAchange] LIKE '%" & PolicyNum & "'"
Debug.Print strSQL

Related

How to optimize a connection in vba

I am working with vba, and I am using an excel sheet to find prices using SQL code within vba. Below is an example of how it is done:
Sub connection()
Set cn = New ADODB.connection
Set cn = CreateObject("ADODB.Connection")
With cn
.Provider = "Microsoft.ACE.OLEDB.12.0"
.ConnectionString = "Data Source=" & ThisWorkbook.Path & "\" & ThisWorkbook.Name & ";" & _
"Extended Properties=""Excel 12.0 Xml;HDR=YES"";"
.Open
End With
End Sub
Function getAddres(ByVal sTableName As String) As String
With Range(sTableName & "[#All]")
getAddres = "[" & .Parent.Name & "$" & .Address(False, False) & "]"
End With
End Function
Function Get_Coeff_1_crit(couv As String, tabelle As String, edit As String, crit1 As String) As Variant
Dim NomFeuille As String, texte_SQL As String
Dim rst As ADODB.Recordset
Dim strRangeAddress As String
Call connection
strRangeAddress = getAddres(edit)
texte_SQL = "SELECT [Coeff] FROM " & strRangeAddress & " WHERE ([Tabelle]=" & Chr(34) & tabelle & Chr(34) & _
" ) AND (( [Booléen_1] = " & crit1 & " ) OR ( [Fixe_1] = " & crit1 & " ) OR (" & crit1 & " BETWEEN [Min_1] AND [Max_1] ))"
Set rst = New ADODB.Recordset
Set rst = cn.Execute(texte_SQL)
On Error Resume Next
Get_Coeff_1_crit = 0
Get_Coeff_1_crit = rst.Fields(0).Value 'ws.Range("N7").CopyFromRecordset Rst
End Function
So I have an input of variables and this function looks for the table and correct variable combination.
My issue is that with many functions each establishing a separate connection with the excel sheet, it takes an insane amount of time to process a lot of prices.
I was wondering if anyone knows of a better way, I am rather new at vba, so I was wondering if we can store dataframes within the process like in python or is there a different way to not establish connections each time.
Thanks.
if you're looping over Get_Coeff_1_crit repeatedly then I can see why it's bogging down while it's reestablishing that connection each pass.
You'd want to do something like this inside the function,
If Not cn is Nothing then 'verify the object is instantiated
If cn.State = adStateClosed then 'State property tells if it's open
Call Connection
End If
End If
'further details on that property - https://www.w3schools.com/asp/prop_comm_state.asp

VBA & SQL how to select specific values based on range in excel?

I am newbie in connection of vba (excel) and oracle database. I have tried to look for some information but I could not find anything that would work for me.
I want to write a query that will return me only rows in which there is a specific values.
My query looks like this:
SQLStr = SQLStr = "SELECT NGKHFHCD, NGKHFNAM, NGKHGNKA, NGKHSZIC, NGKHMTRC, NGKHSNZC, NGKHGCHC, NGKHKKKS, NGKHKTKS FROM NGKH order by NGKHFHCD"
But I want to have something that will be like this SQLStr = "SELECT NGKHFHCD, NGKHFNAM, NGKHGNKA, NGKHSZIC, NGKHMTRC, NGKHSNZC, NGKHGCHC, NGKHKKKS, NGKHKTKS FROM NGKH WHERE NGKHFHCD = SHeet1(A2:A)"
I just don't want to pull out whole table from oracle, because it will take a lots of time so I thought that maybe I can return only specific rows from that table.
Also if there is no searched value in the table I would like to mark it in someway.
Is there anyway to solve it?
my code:
Sub OracleLocalConnect()
Dim RecordSet As New ADODB.RecordSet
Dim con As New ADODB.Connection
Dim ExcelRange As Range
Dim SQLStr As String
Dim ws As Worksheet
con.ConnectionString = "Provider=OraOLEDB.Oracle.1;User ID=***;Password=****;Data Source=*****;"
con.Open
Set RecordSet = CreateObject("ADODB.Recordset")
SQLStr = "SELECT GNKHFHCD, GNKHFNAM, GNKHGNKA, GNKHSZIC, GNKHMTRC, GNKHSNZC, GNKHGCHC, GNKHKKKS, GNKHKTKS FROM GNKH ORDER BY GNKHFHCD"
RecordSet.Open SQLStr, con, adOpenStatic, adLockReadOnly
Set ws = ActiveWorkbook.Sheets("Prices")
Set ExcelRange = ws.Range("A2")
ExcelRange.CopyFromRecordset RecordSet
RecordSet.Close
con.Close
Exit Sub
Exit Sub
End Sub
Untested but this would be close:
Sub OracleLocalConnect()
Dim RecordSet As New ADODB.RecordSet
Dim con As New ADODB.Connection
Dim ExcelRange As Range
Dim SQLStr As String
Dim ws As Worksheet
con.ConnectionString = "Provider=OraOLEDB.Oracle.1;User ID=***;Password=****;Data Source=*****;"
con.Open
Set RecordSet = CreateObject("ADODB.Recordset")
SQLStr = " SELECT GNKHFHCD, GNKHFNAM, GNKHGNKA, GNKHSZIC, GNKHMTRC, " & _
" GNKHSNZC, GNKHGCHC, GNKHKKKS, GNKHKTKS FROM GNKH " & _
" where " & InClause(Sheet1.Range("A2:A1000"), "GNKHFHCD", True) & _
" ORDER BY GNKHFHCD "
RecordSet.Open SQLStr, con, adOpenStatic, adLockReadOnly
Set ws = ActiveWorkbook.Sheets("Prices")
Set ExcelRange = ws.Range("A2")
ExcelRange.CopyFromRecordset RecordSet
RecordSet.Close
con.Close
End Sub
'Create an in clause for an Oracle query
Function InClause(rng As Range, colName As String, Optional quoted As Boolean = False)
'https://stackoverflow.com/questions/400255/how-to-put-more-than-1000-values-into-an-oracle-in-clause
Dim s As String, c As Range, qt As String, sep As String
qt = IIf(quoted, "'", "")
sep = ""
s = "(999, " & colName & ") in ("
For Each c In rng.Cells
If Len(c.Value) > 0 Then
s = s & sep & vbLf & "(999," & qt & c.Value & qt & ")"
sep = "," 'add comma after first pass
End If
Next c
InClause = s & ")"
End Function

VBA Excel ADO SQL Update Query Not Working

I am new to VBA and Excel Scripting, however, I am trying to use it to connect to an SQL Server I have created. I have built a generalized query from a userform, and created a successful SELECT statements that fill my sheet.
However, when I try to update this information in the database I am unsuccessful. The code throws no errors, but I cannot find my changes in the database. Here is my attempt:
Private Sub dbUpdate(Query)
Dim conn As ADODB.Connection
Dim recset As ADODB.Recordset
Dim cmd As ADODB.Command
Dim strConn As String
'Create the connection string
strConn = "Provider=SQLNCLI11;Server=IP-Address;Database=Info;Trusted_Connection=yes;DataTypeCompatibility=80;"
'Create the connection and recordset objects
Set conn = New ADODB.Connection
Set recset = New ADODB.Recordset
'Open the connection
conn.Open strConn
'Open the recordset with the query
'Previous attempt, no errors
'recset.Open Query, conn
'Execute the recordset
Set cmd = New ADODB.Command
'The below execution of a query throws errors I believe
cmd.CommandText = Query
Set recset = cmd.Execute
'Close things up
Set recset = Nothing
'recset.Close
conn.Close
Set conn = Nothing
End Sub
I am pretty sure the query is correct, but I will update tomorrow if I still can't figure it out.
Here is one example that could work for you.
Sub ImportDataFromExcel()
Dim rng As Range
Dim r As Long
Dim conn As ADODB.Connection
Dim strConn As String
Dim strSQL As String
strConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _
"C:\Users\Ryan\Desktop\Coding\Integrating Access and Excel and SQL Server\Access & Excel & SQL Server\" & _
"EXCEL AND ACCESS AND SQL SERVER\Excel & Access\Select, Insert, Update & Delete\Northwind.mdb"
Set conn = New ADODB.Connection
conn.Open strConn
With Worksheets("Sheet1")
lastrow = .Range("A2").End(xlDown).Row
lastcolumn = .Range("A2").End(xlToRight).Column
Set rng = .Range(.Cells(lastrow, 1), .Cells(lastrow, lastcolumn))
End With
'therow = 1
For i = 2 To lastrow
'r = rng.Row
'If r > 1 Then
strSQL = "UPDATE PersonInformation SET " & _
"FName='" & Worksheets("Sheet1").Range("B" & i).Value & "', " & _
"LName='" & Worksheets("Sheet1").Range("C" & i).Value & "', " & _
"Address='" & Worksheets("Sheet1").Range("D" & i).Value & "', " & _
"Age=" & Worksheets("Sheet1").Range("E" & i).Value & " WHERE " & _
"ID=" & Worksheets("Sheet1").Range("A" & i).Value
conn.Execute strSQL
'End If
'r = r + 1
Next i
conn.Close
Set conn = Nothing
End Sub
There are so, so, so many different versions of this. Hopefully you can adapt this example to fit your specific needs.

Update SQL Server table from Excel VBA

I'm trying to use the below code to take the active cell and update a table in SQL Server.
Sub UpdateTable()
Dim rngName As Range
cnnstr = "Provider=SQLOLEDB; " & _
"Data Source=MyServer; " & _
"Initial Catalog=Mydb;" & _
"User ID=User;" & _
"Password=Pwd;" & _
"Trusted_Connection=No"
Set rngName = ActiveCell
'Debug.Print (rngName)
Set cnn = New ADODB.Connection
Application.ScreenUpdating = False
cnn.Open cnnstr
Set rs = New ADODB.Recordset
uSQL = "UPDATE MyTable SET FieldNameX = 1 WHERE FieldNameY = '" & rngName & "' "
rs.CursorLocation = adUseClient
rs.Open uSQL, cnn, adOpenStatic, adLockOptimistic, adCmdText
rs.Close
Set rs = Nothing
cnn.Close
Set cnn = Nothing
Exit Sub
End Sub
When stepping through the code, it run time errors on the line rs.close, says Operation is not allowed when the object is closed I've set and opened the record set in the code so why would it be closed?
What would I need to do to correct the issue and let the active cell populate the query and update the table in SQL Server?
This below is the code I used to be able to update the table in SQL Server, this works just how I wanted. It takes the activecell and updates.
Sub UpdateTable()
Dim cnn As ADODB.Connection
Dim uSQL As String
Dim rngName As Range
Set cnn = New Connection
cnnstr = "Provider=SQLOLEDB; " & _
"Data Source=MyServer; " & _
"Initial Catalog=Mydb;" & _
"User ID=User;" & _
"Password=Pwd;" & _
"Trusted_Connection=No"
Set rngName = ActiveCell
cnn.Open cnnstr
uSQL = "UPDATE MyTable SET FieldNameX = 1 WHERE FieldNameY= '" & rngName & "' "
'Debug.Print (uSQL)
cnn.Execute uSQL
cnn.Close
Set cnn = Nothing
Exit Sub
End Sub

vba to populate a textbox from SQL queries when combobox is change it

I have a userform with one textbox and one combobox in EXCEL.
This userform is connected to a small data base (one table with 2 columns)
Combobox is populated with the values from the first column of databasqe table
I like when the combobox is changing the textbox to be automatic populated with the corespondent value from the second column.
I have the following code but it is not working:
Please, can someone help me?
Sub PopulateTB()
Dim rs As Recordset
Dim db As database
Dim SQL As String
Set db = OpenDatabase(ThisWorkbook.Path & "\materiale.mdb")
SQL = "SELECT values_col2 FROM table_db WHERE values_col1 = " & UserForm1.ComboBox1.Value & ";"
Set rs = db.OpenRecordset(sql)
Do Until rs.EOF = True
UserForm1.TextBox1.Value = rs.Fields(SQL)
rs.MoveNext
Loop
rs.Close
Set db = Nothing
Set rs = Nothing
End Sub
Thank you!
I putted like this and it is ok
Sub PopulateTB(ByRef ctl As Control, ByVal strTable As String, ByVal strField As String, Optional ByVal strCriteria As String)
Dim strSQL As String
Dim strSQLcount As String
Dim rs As Recordset
Dim db As Database
Dim rsCount As Recordset, totalCol As Long
Dim varRecords As Variant
Set db = OpenDatabase(ThisWorkbook.Path & "\materiale.mdb")
strSQLcount = ""
strSQLcount = strSQLcount & " " & "SELECT COUNT(*) AS Total FROM " & "[" & strTable & "]"
Set rsCount = db.OpenRecordset(strSQLcount)
totalCol = rsCount!Total
rsCount.Close
Set rsCount = Nothing
strSQL = ""
strSQL = strSQL & " " & "SELECT" & "[" & strField & "]"
strSQL = strSQL & " " & "FROM " & "[" & strTable & "]"
Set rs = db.OpenRecordset(strSQL)
varRecords = rs.GetRows(totalCol)
ctl.Value = varRecords(0, Me.ComboBox1.ListIndex)
rs.Close
db.Close
Set db = Nothing
Set rs = Nothing
End Sub