Pass VBA Variable into Access Query(Excel VBA) - sql

Im new at trying to construct queries out of vba. I am trying to figure out how to pass a variable inside the VBA syntax. Mind showing me where im dumb?
I tried this below but there's an automation error that pops up. Ive noticed from playing aroudn that automation errors come up when youve just got syntax wrong, so hopefully its something small?
Any help is greatly appreciated
Sub GetDataFromAccess()
Dim cmd As New ADODB.Command, rs As ADODB.Recordset
Dim recordNum As Integer
recordNum = 7
cmd.ActiveConnection = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\Users\Ashleysaurus\Desktop" & "\" & "xyzmanu3.accdb"
cmd.CommandType = adCmdText
cmd.CommandText = "SELECT * FROM Invoice WHERE OrderNumber <" & "'" & recordNum & "'" & "ORDER BY OrderNumber ASC"
Set rs = cmd.Execute
Sheet1.Range("A2").CopyFromRecordset rs
rs.Close
cmd.ActiveConnection.Close
Debug.Print "Done!"
End Sub

While learning to build VBA queries, consider parameterized queries and avoid any need of quotes! This is an industry best practice across all languages when passing values in dynamic SQL queries.
Sub GetDataFromAccess()
Dim cmd As New ADODB.Command, rs As ADODB.Recordset
Dim recordNum As Integer
recordNum = 7
With cmd
.ActiveConnection = "Provider=Microsoft.ACE.OLEDB.12.0;" _
& "Data Source=C:\Users\Ashleysaurus\Desktop" & "\" & "xyzmanu3.accdb"
.CommandType = adCmdText
.CommandText = "SELECT * FROM Invoice" _
& " WHERE OrderNumber < ? ORDER BY OrderNumber ASC"
End With
cmd.Parameters.Append cmd.CreateParameter("recordNumParam", adInteger, adParamInput, 10)
cmd.Parameters(0).Value = recordNum
Set rs = cmd.Execute
Sheet1.Range("A2").CopyFromRecordset rs
rs.Close
cmd.ActiveConnection.Close
Debug.Print "Done!"
End Sub

Assuming OrderNumber is a number, do not use quotes.
Also make sure you have a space before Order By:
cmd.CommandText = "SELECT * FROM Invoice WHERE OrderNumber <" & recordNum & " ORDER BY OrderNumber ASC"

Related

Assign Recordset to Variable in VBA

I am trying to assign variables value from recordset and insert values into an Access table. I also need to clear the table and insert new set of data before inserting. The recordset is from a stored procedure in SQL Server. Following does not seem to work:
Dim conn As ADODB.Connection, cmd As ADODB.Command, rst As
ADODB.Recordset
Dim Itm As String, JobNo As Integer, RevNo As Integer, DUStatus As Date, LDUStatus As Date, UTrigger As String
Set conn = New ADODB.Connection
conn.ConnectionString = "Provider='sqloledb';Data Source=SERVER;Initial Catalog='Database';Integrated Security='SSPI';"
conn.Open
Set cmd = New ADODB.Command
With cmd
.ActiveConnection = conn
.CommandText = "rg_ItemsQuerySP"
.CommandType = adCmdStoredProc
.Parameters.Append .CreateParameter("#JobNo", adInteger, adParamInput, , TempJobNo)
.Parameters.Append .CreateParameter("#RevNo", adInteger, adParamInput, , TempRevNo)
End With
Set rst = cmd.Execute
If rst.EOF Then Exit Function
rst.MoveLast
rst.MoveFirst
With rst
Do While Not .EOF
Itm = rst.Fields("Item")
JobNo = rst.Fields("Job No")
RevNo = rst.Fields("Revision No")
DUStatus = rst.Fields("DateUpdatedStatus")
LDUStatus = rst.Fields("LastDateUpdatedStatus")
UTrigger = rst.Fields("UpdateTrigger")
DoCmd.RunSQL ("INSERT INTO ItemsQuerySP_Temp values " & Itm & ", " & JobNo & ", " & RevNo & ", " & DUStatus & ", " & LDUStatus & ", " & UTrigger & ";")
rst.MoveNext
Loop
End With
conn.Close
Set conn = Nothing
Possibly your issue is the lack of quotes around string variables which would raise SQL error. Since you use ADO parameters, continue to use parameters via QueryDef, avoiding string concatenation (i.e., ampersands) or punctuation (i.e., quotes):
SQL (save below as an MS Access saved query, adjust types as needed: Text, Long, Double, etc.)
PARAMETERS PrmItm Text, PrmJobNo Text, PrmRevNo Text,
PrmDUStatus Text, PrmLDUStatus Text, PrmUTrigger Text;
INSERT INTO ItemsQuerySP_Temp
VALUES(PrmItm, PrmJobNo, PrmRevNo,
PrmDUStatus, PrmLDUStatus, PrmUTrigger)
VBA (relevant section)
Dim qdef AS QueryDef
' ... same as above...
Set qdef = CurrentDb.QueryDefs("mySavedQuery")
With rst
Do While Not .EOF
' BIND PARAMETERS
qdef!PrmItm = rst.Fields("Item")
qdef!PrmJobNo = rst.Fields("Job No")
qdef!PrmRevNo = rst.Fields("Revision No")
qdef!PrmDUStatus= rst.Fields("DateUpdatedStatus")
qdef!PrmLDUStatus = rst.Fields("LastDateUpdatedStatus")
qdef!PrmUTrigger = rst.Fields("UpdateTrigger")
' EXECUTE ACTION
qdef.Execute dbFailOnError
.MoveNext
Loop
End With
Set qdef = Nothing

Performing find on recordset with criteria for two fields

I am attempting to perform a Find on a recordset with two criteria, one for each field. I am, however, running into the following error:
Arguments are of the wrong type, are out of acceptable range, or are in conflict with one another
Set rs = getdata("Select Distinct astAssetTypes.Code AT, astComponents.Code Comp FROM dbo.astComponents JOIN dbo.astAssetTypes ON astAssetTypes.Id = astComponents.AssetTypeId WHERE astAssetTypes.Code IN(" & ComponentCode & ")")
If Not rs.EOF Then
rs.Find rs.Fields(1).Name & "='" & tempArr(b, 1) & "' AND " & rs.Fields(0).Name & "='" & tempArr(b, 9) & "'"
End If
Printing the find criteria results in:
Comp='0738.D100.L00.55' AND AT='9211.D108.D07.01_02.02'
I'm puzzled as to why it's not working. Judging by how online sources stating such a Find function is possible, I don't see why this won't process.
The query is valid, getdata is a custom function:
Public Function getdata(query As String) As ADODB.Recordset
Dim cnn As ADODB.Connection
Dim connstring As String
Set cnn = New ADODB.Connection
connstring = "Provider=SQLOLEDB;Data Source=omitted;Connect Timeout=180"
cnn.Open connstring
Set getdata = New ADODB.Recordset
getdata.CursorLocation = adUseClient
getdata.Open query, connstring, adOpenStatic, adLockBatchOptimistic
cnn.Close
End Function

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.

Pass a value dynamically to SQL Server through VBA

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

Excel VBA ADO - Writing to access database - Only first row of recordset written repeatedly

i have the following code which should take a recordset from an oracle database and write it to an access database.It has about 2000 rows and im expecting to see the same transferred to access. The problem is, only the first row of data is written to the database in an infinite loop! The getconnection function is a custom function that just connects to Access.
What do i need to change to get the code to work? thanks
Sub InsertLine(rS As ADODB.recordset)
Dim adoConn As ADODB.Connection, adoComm As ADODB.Command
Set adoConn = GetConnection("access")
Set adoComm = New ADODB.Command
With adoComm
Set .ActiveConnection = adoConn
Do Until rS.EOF
.CommandText = "INSERT INTO Products ([Product], [Category]) " & _
"VALUES(?,?)"
.Parameters.Append .CreateParameter(Type:=adVarWChar, Value:=rS![ITMDSC], Size:=255)
.Parameters.Append .CreateParameter(Type:=adVarWChar, Value:=rS![GRPDSC], Size:=255)
.Execute
rS.MoveNext
Debug.Print rS![ITMDSC]
Loop
End With
adoConn.Close
End Sub
Thanks for your responses guys. Ive edited the code as follows, but still getting the same issue. Or did i not understand what you meant? sorry im quite new at this. The debug line is showing the correct next record. cheers
Sub InsertLine(rS As ADODB.recordset)
Dim adoConn As ADODB.Connection, adoComm As ADODB.Command, S As String, S2 As String
Set adoConn = GetConnection("access")
Set adoComm = New ADODB.Command
With adoComm
Set .ActiveConnection = adoConn
.CommandText = "INSERT INTO Products ([Product], [Category]) " & _
"VALUES(?,?)"
.Parameters.Append .CreateParameter(Type:=adVarWChar, Value:=rS![ITMDSC], Size:=255)
.Parameters.Append .CreateParameter(Type:=adVarWChar, Value:=rS![GRPDSC], Size:=255)
S = rS![ITMDSC]
S2 = rS![GRPDSC]
Do Until rS.EOF
.CommandText = "INSERT INTO Products ([Product], [Category]) " & _
"VALUES(S , S2)"
.Execute
rS.MoveNext
Debug.Print rS![ITMDSC]
Loop
End With
adoConn.Close
End Sub
Why use a parameter query? it's making it overcomplicated...
.CommandText = "INSERT INTO Products ([Product], [Category]) " & _
"VALUES('" & rS![ITMDSC] & "','" & rS![GRPDSC] & "')"
.Execute
rS.MoveNext
if you do want to use a parameter query, then a
.Parameters.Refresh
should clear out current parameters