Pass a value dynamically to SQL Server through VBA - sql

Disclaimer: I am new to VBA.
I hope to pass the value in the SQL query (30881570) through a field on my Excel sheet. I have tried a few different things.
Private Sub cmdImport_Click()
Call cmdClear_Click
Dim conn As New ADODB.Connection, cmd As New ADODB.Command, rs As New ADODB.Recordset
With conn
.ConnectionString = _
"Provider=SQLOLEDB; " & _
"Data Source=PRGTAPPDBSWC019; " & _
"Initial Catalog=DETEP;" & _
"Integrated Security=SSPI;"
.Open
End With
With cmd
.ActiveConnection = conn
.CommandText = "SELECT * FROM [dbo].[tbl_PMHeader] WHERE [PMHeader_PM_NUM] = '30881570'"
.CommandType = adCmdText
End With
Set rs.Source = cmd
rs.Open
'Need this to populate header row, starting at specified Range
For intColIndex = 0 To rs.Fields.Count - 1
Range("B1").Offset(0, intColIndex).Value = rs.Fields(intColIndex).Name
Next
'This is where your data table will be copied to
ActiveSheet.Range("B2").CopyFromRecordset rs
Worksheets("Sheet1").Columns("B:BB").AutoFit
Worksheets("Sheet1").Range("A25").Formula = "=COUNTA(B:B)-1"
End Sub

It looks like you're already passing that value as criteria for the query's WHERE statement.
If you're asking how to replace that with a value from a worksheet, here's one way:
.CommandText = "SELECT * FROM [dbo].[tbl_PMHeader] " & _
"WHERE [PMHeader_PM_NUM] = '" & Sheets("mySheet").Range("A1") & "'"
...where your worksheet is named mySheet and the value is in cell A1.
This is the simplest method, potentially fine for internal use by trusted parties, but if the value has any ' single-quotes in it, you will get an error.
Worst-case scenario, this method leaves you open to SQL Injection attacks. Depends on your needs (and whether this this is just a school assignment), you may be better of using a parameter query.
See Also:
MSDN Blog : How and Why to Use Parameterized Queries
MSDN Blog : Everything About Using Parameters from Code

Private Sub cmdImport_Click()
Dim conn As New ADODB.Connection
Dim cmd As New ADODB.Command
Dim rs As New ADODB.Recordset
Dim sqlStr As String
With conn
.ConnectionString = _
"Provider=SQLOLEDB; " & _
"Data Source=PRGTAPPDBSWC019; " & _
"Initial Catalog=DETEP;" & _
"Integrated Security=SSPI;"
.Open
End With
orderno = Sheets("Sheet1").Range("A22")
strSql = "SELECT * FROM [dbo].[tbl_PMHeader] " & _
"WHERE [PMHeader_PM_NUM] = " & orderno
With cmd
.ActiveConnection = conn
.CommandText = strSql
.CommandType = adCmdText
End With
'Call cmdClear_Click
Set rs.Source = cmd
rs.Open
'Need this to populate header row, starting at specified Range
For intColIndex = 0 To rs.Fields.Count - 1
Range("B1").Offset(0, intColIndex).Value = rs.Fields(intColIndex).Name
Next
'This is where your data table will be copied to
ActiveSheet.Range("B2").CopyFromRecordset rs
Worksheets("Sheet1").Columns("B:BB").AutoFit
Worksheets("Sheet1").Range("A25").Formula = "=COUNTA(B:B)-1"
End Sub

Related

VBA ADODB SQL query returns "Automation error" when reading a variable from cell, works well when a value is assigned in VBA code

Debugger returns automation error when running the following :
Private Sub setDB()
Dim SQL As String
Dim Var As String
Dim conn As ADODB.Connection
Set conn = New ADODB.Connection
conn.Open "DRIVER={MariaDB ODBC 3.0 Driver}" _
& ";SERVER=" & "localhost" _
& ";DATABASE=" & "pbx" _
& ";USER=" & "root" _
& ";PASSWORD=" & "r00t" _
Var = Worksheets(3).Range("B2").Value
SQL = "UPDATE ps_product SET ean13='" & Var & "' WHERE id_product=12"
conn.Execute (SQL)
However when I assign a value to Var like this: Var=10, the code runs fine. Am I missing something here? I have searched on the internet for several days and I didn't find anything similar. Can some1 help or maybe send a link to a similar issue, please?
Consider parameterization, the preferred method to bind application layer values to executed SQL queries. ADO supports this approach with Command parameters. This avoids messy concatenation, quote punctation, and escape needs if string value contains special characters like single quotes.
Dim Sql As String, Var As String
Dim conn As ADODB.Connection
Dim cmd As ADODB.Command ' NEW OBJECT TO INITIALIZE
Set conn = New ADODB.Connection
conn.Open "DRIVER={MariaDB ODBC 3.0 Driver}" _
& ";SERVER=" & "localhost" _
& ";DATABASE=" & "pbx" _
& ";USER=" & "root" _
& ";PASSWORD=" & "r00t" _
' PREPARED STATEMENT WITH PLACEHOLDER (NO QUOTES OR CONCATENATION)
Sql = "UPDATE ps_product SET ean13=? WHERE id_product=12"
' CONVERT TO NEEDED TYPE
Var = CStr(Worksheets(3).Range("B2").Value)
Set cmd = New ADODB.Command
With cmd
.ActiveConnection = conn
.CommandText = Sql
.CommandType = adCmdText
' BIND PARAMS AND DEFINE TYPE AND LENGTH
.Parameters.Append .CreateParameter("prm", adVarChar, adParamInput, 255, Var)
' EXECUTE ACTION
.Execute
End cmd
The query is working when the desired cell is passed as a parameter. (Thx to #Parfait for the hint)
Some useful info which helped me figure this out can be found here:
VBA, ADO.Connection and query parameters
https://learn.microsoft.com/en-us/sql/ado/guide/data/creating-and-executing-a-simple-command?view=sql-server-ver15
https://learn.microsoft.com/en-us/sql/ado/guide/data/passing-parameters-to-a-named-command?view=sql-server-ver15
Working example:
Private Sub setDB()
Dim Cm As New ADODB.Command
Dim Rs As New ADODB.Recordset
Dim conn As ADODB.Connection
Set conn = New ADODB.Connection
Test = Worksheets(3).Range("B2").Value
CommandText = "UPDATE ps_product SET ean13=? WHERE id_product=12;"
conn.Open "DRIVER={MariaDB ODBC 3.0 Driver}" _
& ";SERVER=" & "localhost" _
& ";DATABASE=" & "pbx" _
& ";USER=" & "root" _
& ";PASSWORD=" & "r00t" _
Cm.CommandText = CommandText
Cm.CommandType = adCmdText
Cm.Name = "Var"
Set Cm.ActiveConnection = conn
conn.Var Test, Rs
End Sub

SQL Query Returns empty Recordset

I'm trying to learn how to connect to a SQL Server DB from Excel DB. I've tried to reduce the code to dead simple to begin with. I've looked at several answers to related questions, however, I cannot figure out why this doesn't work. It executes all the way through. (The code shown here is somewhat anonymized.)
The query finds the database, because if the table name is invalid it throws an error. However it always returns record count = -1. I can eyeball the table in MSSMS and it has data. Same result for other tables in the DB.
Public Sub ADOtest1()
Dim Conn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim strConnString As String
strConnString = "Provider='SQLOLEDB'" & ";" & _
"Data Source='XXX-XPS\SQLEXPRESS'" & ";" & _
"Initial Catalog='XXXXX'" & ";" & _
"Integrated Security='SSPI'"
Set Conn = New ADODB.Connection
Conn.Open strConnString
' the query finds the DB, because if the table name is incorrect, it throws an error
strSQLString = "SELECT * from t300_XXXX"
Set rs = Conn.Execute(strSQLString)
wrkRecordCount = rs.RecordCount
'--- just some test breakpoints
If wrkRecordCount = -1 Then
a = "" '--- code keeps arriving here
Else
a = ""
End If
rs.Close
Conn.Close
End Sub
Answer from Srinika below worked:
Set rs = Conn.Execute(strSQLString)
rs.Close
rs.CursorLocation = adUseClient
rs.Open
I'll post two examples, so please refer.
First Example
Sub ExampleSQL()
Dim cnn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim strSQL As String
Set cnn = New ADODB.Connection
'Set the provider property to the OLE DB Provider for ODBC.
'cnn.Provider = "MSDASQL"
'cnn.Provider = "Microsoft.ACE.OLEDB.12.0"
'cnn.Provider = "MSOLAP"
'cnn.Provider = "SQLOLEDB.1"
' Open a connection using an ODBC DSN.
cnn.ConnectionString = "driver={SQL Server};" & _
"server=severname;uid=sa;pwd=password;database=test"
Set rs = New ADODB.Recordset
strSQL = "SELECT * FROM [your Table] "
rs.Open strSQL, cnn.ConnectionString, adOpenForwardOnly, adLockReadOnly, adCmdText
cnn.Open
If cnn.State = adStateOpen Then
Else
MsgBox "Sever is not connected!! "
Exit Sub
End If
If Not rs.EOF Then
With Ws
.Range("a4").CurrentRegion.ClearContents
For i = 0 To rs.Fields.Count - 1
.Cells(4, i + 1).Value = rs.Fields(i).Name
Next
.Range("a5").CopyFromRecordset rs
.Columns.AutoFit
End With
Else
MsgBox "No Data!!", vbCritical
End If
rs.Close
Set rs = Nothing
cnn.Close
Set cnn = Nothing
End Sub
Second Example
Sub getDataFromServer()
Dim con As New ADODB.Connection
Dim cmd As New ADODB.Command
Dim rs As New ADODB.Recordset
Dim i As Integer
con.ConnectionString = "Provider=SQLOLEDB.1;" _
& "Server=(local);" _
& "Database=TEST;" _
& "Integrated Security=SSPI;" _
& "DataTypeCompatibility=80;"
con.Open
Set cmd.ActiveConnection = con
cmd.CommandText = "SELECT * FROM [your Table]"
Set rs = cmd.Execute
Range("A1").CopyFromRecordset rs
con.Close
Set con = Nothing
End Sub

VBA SQL query with WHERE clause

I'm trying to write VBA code to get SQL data into Excel. Everything works fine except the WHERE condition. I think the problem may be with quotation. This is my query:
Sub Engineering_Milestone()
Dim v_project As String
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim sql As String
Set cn = New ADODB.Connection
Set rs = New ADODB.Recordset
v_project = Worksheets("Parameters").Range("B1").Value
'cn.Open "Provider = x.1; Data Source=x; Initial Catalog=x; Integrated Security=x"
cn.Open "Provider = Sx; Data Source=x; Initial Catalog=x; Integrated Security=x"
Worksheets("Engineering_Milestone").Range("A2:G5000").ClearContents
sql = " SELECT A.ENGINEER_ID, B.[Description], B.BUDGET_APPROVED, A.MILESTONE, A.[DESCRIPTION], A.PCT_COMPLETE, A.SCHEDULE_DATE FROM X as A Inner Join X as B on A.ENGINEER_ID = B.ENGINEER_ID WHERE B.Project_ID = " & "'" & v_project & "'" and A.Project_ID = " & "'" & v_project & "'"
rs.Open sql, cn
Sheets("Engineering_Milestone").Cells(2, 1).CopyFromRecordset rs
rs.Close
cn.Close
End Sub
It works fine when the SQL query has one condition i.e ...where B.Project_ID = " & "'" & v_project & "'" (without second condition -> and A.Project_ID = " & "'" & v_project & "'").
I'm very new to this so would be grateful if anyone can help...Many thanks.
As I said never write SQL code by string concatenation, use parameters. After seeing your code it is now a little bit easier:
Sub Engineering_Milestone()
Dim v_project As String
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim sql As String
Dim cmd as ADODB.Command
Set cn = New ADODB.Connection
v_project = Worksheets("Parameters").Range("B1").Value
'cn.Open "Provider = x.1; Data Source=x; Initial Catalog=x; Integrated Security=x"
cn.Open "Provider = Sx; Data Source=x; Initial Catalog=x; Integrated Security=x"
Worksheets("Engineering_Milestone").Range("A2:G5000").ClearContents
sql = "SELECT A.ENGINEER_ID, B.[Description], B.BUDGET_APPROVED, " & _
" A.MILESTONE, A.[DESCRIPTION], A.PCT_COMPLETE, A.SCHEDULE_DATE" & _
" FROM X as A" & _
" Inner Join X as B " & _
" on A.ENGINEER_ID = B.ENGINEER_ID and B.Project_ID = A.Project_ID" & _
" WHERE B.Project_ID = ?"
set cmd = New ADODB.Command
cmd.ActiveConnection = cn
cmd.CommandText = sql
cmd.Parameters.Append cmd.CreateParameter("#projectId", adVarchar)
cmd.Parameters("#projectId").Value = v_project
Set rs = cmd.Execute()
Sheets("Engineering_Milestone").Cells(2, 1).CopyFromRecordset rs
rs.Close
cn.Close
End Sub
NOTE: Your SQL is really vague. You are doing a self join just to create some kind of cartesian join? Probably in fact engineerId, projectId combinations are unique. If that is correct than you could simplify your SQL:
sql = "SELECT ENGINEER_ID, [Description], BUDGET_APPROVED, " & _
" MILESTONE, [DESCRIPTION], PCT_COMPLETE, SCHEDULE_DATE" & _
" FROM X" & _
" WHERE Project_ID = ?"
You only provided a half of one line of code so I'm can only guess that this is what you're trying for:
"where B.Project_ID = '"& v_project &"'& And A.Project_ID = ' & v_project "'"
Strings can be confusing when entering/exiting multiple types of quotes, but when you're troubleshooting a problem building a string, start be remove all the variables and just using a hard-coded SQL string.
Once that's working, start replacing the values with variables (and appropriate quotes) one at a time.
Consider SQL parameterization, the industry best practice when passing values into SQL queries -not just in VBA or your database but across all langauge interfaces to any databases. This process is more readable and maintainable as you no longer worry about quotes. Plus, code (SQL query) is separated from data (VBA variables).
Using ADO, parameters can be defined and set using the Command Object.
Dim v_project As String, sql As String
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim cmd As New ADODB.Command
v_project = Worksheets("Parameters").Range("B1").Value
cn.Open "Provider = Sx; Data Source=x; Initial Catalog=x; Integrated Security=x"
' PREPARED STATEMENT WITH QMARK PLACEHOLDERS
sql = "SELECT A.ENGINEER_ID, B.[Description], B.BUDGET_APPROVED, A.MILESTONE," _
& " A.[DESCRIPTION], A.PCT_COMPLETE, A.SCHEDULE_DATE" _
& " FROM X AS A INNER JOIN X as B ON A.ENGINEER_ID = B.ENGINEER_ID" _
& " WHERE B.Project_ID = ? AND A.Project_ID = ?"
' COMMAND OBJECT
Set cmd = New ADODB.Connection
With cmd
.ActiveConnection = cn ' CONNECTION OBJECT
.CommandText = sql
.CommandType = adCmdText
' BINDING PARAMETERS
.Parameters.Append .CreateParameter("a_projid", adVarChar, adParamInput, , v_project)
.Parameters.Append .CreateParameter("b_projid", adVarChar, adParamInput, , v_project)
End With
' ASSIGN TO RECORDSET
Set rs = cmd.Execute
With Worksheets("Engineering_Milestone")
.Range("A2:G5000").ClearContents
.Cells(2, 1).CopyFromRecordset rs
End With
rs.Close: cn.Close
Set cmd = Nothing: Set rs = Nothing: Set cn = Nothing
Never write SQL code like that concatenating strings. Instead simply use parameters. ie: (say vProject is integer)
.. where B.Project_ID = ? And A.Project_ID = ?
cmd.Parameters.Append .CreateParameter("#projectId", adInteger, adParamInput, 0, vProject)
cmd.Parameters.Append .CreateParameter("#projectId", adInteger, adParamInput, 0, vProject)
Note: cmd is your ADODB.Command object that you use for your command.

Connect to a SQL Server database with Outlook

I want to connect to a MS SQL Server database using an Outlook macro. But I don't know if the code is wrong or I need to add a library/driver or what happens here but it doesn't work.
Private Sub Application_Startup()
On Error GoTo ExitHere
'adodb connection to other database
stg_cn.Open "Provider = SQLOLEDB;" & _
"Data Source = 192.168.100.100;" & _
"Initial Catalog = hugeDB;" & _
"Integrated Security=SSPI;" & _
"User ID = oneuser;" & _
"Password = onepassword;"
sQuery = "SELECT * FROM documents where location = 'IE'"
'set reference to query
Set cmd = New ADODB.Command
cmd.ActiveConnection = stg_cn
cmd.CommandType = adCmdText
cmd.CommandText = sQuery
Set rs = cmd.Execute
Do While Not rs.EOF
For i = 0 To rs.Fields.count - 1
MsgBox (i + 1)
Next
rs.MoveNext
Loop
ExitHere:
If Not stg_cn Is Nothing Then stg_cn.Close
Set rs = Nothing
Set stg_cn = Nothing
Exit Sub
End Sub
On eye-test I am not able to figure out whats wrong, I think it has to do something with the way you are doing the ADO operations.
But I am just putting up the last macro I wrote to connect to SQL-Server from Macro. Hope it helps.
Private Sub Workbook_Open()
On Error GoTo ErrorHandler
'**************************************Initialize Variables**************************************
sServer = "<SQL SERVER Server>"
sDBName = "<SQL SERVER DB>"
'**************************************Open Connection**************************************
'adodb connection to other database
stg_cn.Open "Provider=SQLOLEDB;Data Source=" & sServer & _
";Initial Catalog=" & sDBName & _
";Integrated Security=SSPI;"
sQuery = "SELECT * " & _
"FROM Table "
'set reference to query
Set cmd = New ADODB.Command
cmd.ActiveConnection = stg_cn
cmd.CommandType = adCmdText
cmd.CommandText = sQuery
Set rs = cmd.Execute
Do While Not rs.EOF
For i = 0 To rs.Fields.Count - 1
<PERFORM OPERATIONS>
Next
rs.MoveNext
Loop
ExitHere:
If Not stg_cn Is Nothing Then stg_cn.Close
Set rs = Nothing
Set stg_cn = Nothing
Exit Sub
End Sub
The connection string #CodePhobia has provided should work for you.
The below just includes User ID and Password functionality, as your original question showed trying to connect using this.
Dim rsConn as ADODB.Connection
Set rsConn = New ADODB.Connection
With rsConn
.ConnectionString = "Provider = sqloledb;" & _
"Data Source = myServerName;" & _
"Initial Catalog = myCatalog;" & _
"Integrated Security=SSPI;" & _
"User ID = myUserID;" & _
"Password = myPassword;"
.Open
End With
You can use this website to find connection strings in the future. It should cover all possible connections you wish to establish.

Recordset in VB6.0

I'm retrieving Data from a Database in a record set using VB6... so while retrieving data using Select in SQL I added a column called Comments along wit it so that in the recordset, all the columns of the table+'Comments' column would be present... I don't want to(and also I cannot) update any contents in the database as i'm only 'fetching' data frm the database now...
Now when i pass the fetched data for validation, I want to fill the 'comments' Column with the respective errors if the particular row in the recordSet is erroneous).... When i do that i get an error saying "I'm not authorized to do that!!(to update the 'Comments' Column"....
Now My Question is "In what way i can solve this problem???".. I tried to replicate this recordset and there by now filling the 'comments'column (in the replicated one) which in turn showed the same error... It seems this could be because the duplicate one(recordSet) just retains the properties of the original one...
Can u any1 help how to solve this???? Any ways to replicate the recordset(without inheriting its properties something)??????
I think you are just asking how to do a disconnected recordset.
For that you just change the cursor location of the recordset.
Dim rstTest as ADODB.RecordSet
Set rstTest = New ADODB.RecordSet
With rstTest
.CursorLocation = adUseClient
.Open "your sql here", your_connection_object, adOpenStatic, adLockBatchOptimistic, adCmdText
' now disconnect it and force the local copy
.ActiveConnection = Nothing
End With
Not exactly what you are looking for, but this is how I do it:
Create a class to encapsulate the recordset ('Customer' class for 'Customer' table)
Add your Comment property to the class and not to recordset
Add a Validate method to your class. Have it write to your Comment property (I use an Errors Collection)
Read the recordset
Parse it into a "new Customer"
Validate
Check the Comment property (or the Errors Collection)
You can use the MSDataShape with its SHAPE..APPEND syntax to append a new Field to an ADO Recordset. Here's a quick example using Jet (a.k.a. MS Access):
Sub ShapeAppendField()
On Error Resume Next
Kill Environ$("temp") & "\DropMe.mdb"
On Error GoTo 0
Dim cat
Set cat = CreateObject("ADOX.Catalog")
With cat
.Create _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & _
Environ$("temp") & "\DropMe.mdb"
Dim jeng
Set jeng = CreateObject("JRO.JetEngine")
jeng.RefreshCache .ActiveConnection
Set .ActiveConnection = Nothing
End With
Dim con
Set con = CreateObject("ADODB.Connection")
With con
.ConnectionString = _
"Provider=MSDataShape;" & _
"Data Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & _
Environ$("temp") & "\DropMe.mdb"
.CursorLocation = 3
.Open
.Execute _
"CREATE TABLE Test (" & _
"existing_col INTEGER NOT NULL);"
.Execute _
"INSERT INTO Test (existing_col)" & _
" VALUES (1);"
Dim rs
Set rs = CreateObject("ADODB.Recordset")
With rs
.CursorType = 2
.LockType = 4
.Source = _
"SHAPE {" & _
" SELECT existing_col" & _
" FROM Test" & _
"} APPEND NEW adInteger AS new_col"
Set .ActiveConnection = con
.Open
Set .ActiveConnection = Nothing
.Fields("new_col").value = 55
MsgBox .GetString
.Close
End With
End With
End Sub