I have a VBS program that works great. My code below:
Dim qry, db, cs, cn, cmd
'Query to add all the following which date more than 20 days in the table ToUnfollow
qry = "INSERT INTO ToUnfollow " & _
"SELECT Name FROM Follow t1 " & _
"WHERE t1.Joined < datetime(CURRENT_DATE, '-20 days') " & _
"AND NOT EXISTS (SELECT 1 FROM ToUnfollow t2 WHERE t2.Name=t1.Name);"
db = "C:\Users\Quentin\Downloads\Quentin-Classementhashtags.db"
cs = "DRIVER=SQLite3 ODBC Driver;Database=" & db
'Connection to database
Set cn = CreateObject("ADODB.Connection")
cn.Open cs
Set cmd = CreateObject("ADODB.Command")
Set cmd.ActiveConnection = cn
'Execute the SQL query
cmd.CommandText = qry
cmd.Execute
'Close the connection
cn.Close
I want to display all records from the SQL query in a MsgBox. I tried several solutions from several forums but none works for me.
My solution :
Dim qry, db, cs, cn, cmd, adoRec, name
'Query to add all the following which date more than 20 days in the table
'ToUnfollow
qry = "SELECT Name, Joined FROM Follow t1 " & _
"WHERE t1.Joined < datetime(CURRENT_DATE, '-20 days')"
db = "C:\Users\Quentin\Downloads\Quentin-Classementhashtags.db"
cs = "DRIVER=SQLite3 ODBC Driver;Database=" & db
'Connection to database
Set cn = CreateObject("ADODB.Connection")
cn.Open cs
Set cmd = CreateObject("ADODB.Command")
Set cmd.ActiveConnection = cn
cmd.CommandText = qry
Set adoRec = cmd.Execute()
'Iterate through the results
While Not adoRec.EOF
name = name & vbCr & adoRec(0) & " - " & adoRec(1)
adoRec.MoveNext
Wend
MsgBox name
'Close the connection
cn.Close
Related
I use VBA Word with Access, to create/store medical visit notes for Nursing homes.
The following is an example of how I get data out of Access (obviously picking up mid-Sub). This is populating a ComboBox in Word which gives me a list of all my patients, it is working great!
'....
Set Conn = New ADODB.Connection
Set rs = New ADODB.Recordset
strConn = ActiveDocument.CustomDocumentProperties("strConn").Value
Conn.Open (strConn)
qry = "SELECT * FROM tblPatientInfo ORDER BY LastName, Firstname"
rs.Open qry, Conn, adOpenKeyset
rs.MoveFirst
x = 0
While Not rs.EOF
F1.ComboDashPtList.AddItem
F1.ComboDashPtList.List(x, 0) = rs.Fields("LastName").Value & ""
F1.ComboDashPtList.List(x, 1) = rs.Fields("FirstName").Value & ""
F1.ComboDashPtList.List(x, 2) = Format(rs.Fields("DOB").Value, "MM\/dd\/yyyy") & ""
F1.ComboDashPtList.List(x, 3) = rs.Fields("MedNumber").Value & ""
rs.MoveNext
x = x + 1
Wend
rs.Close
Exit Sub`
'....
This is an example of how I send my data back to Access (again picking up mid-Sub).
` Set Conn = New ADODB.Connection
Set rs = New ADODB.Recordset
Conn.Open (strConn)
rs.Open strDBPtInfo, strConn, adOpenKeyset, adLockOptimistic, adCmdTable
rs.AddNew
rs!MedNumber = strMedNum
rs!LastName = strLastName
rs!Firstname = strFirstName
rs!DOB = dtDOB
rs.Update `
'....
Sometimes I need to completely overwrite or add to a specific field in a certain Access table. For years 'someone may have an allergy to penicillin, but suddenly they are also allergic to codeine, so that has to 'be updated. This is the approach I've taken but I keep getting an error:
'....
` Set Conn = New Connection
Set rs = New Recordset
Conn.Open (strConn)
strUpdateqry = "SELECT * FROM tblMedHxInfo WHERE MedNumber = " & Chr(34) & strMedNum & Chr(34) & ""
rs.Open strUpdateqry, strConn, adOpenKeyset
rs!Allergies = "Penicillin, Codeine"
rs.Update
If rs.State = 1 Then rs.Close
If Conn.State = 1 Then Conn.Close
Set rs = Nothing
Set Conn = Nothing`
....
This is the Error:
"Run-time error '3251': Current Recordset does not support updating.
This may ne a limitation of the provider, or of the selected locktype"
'Any help would be greatly appreciated!
'Thanks,
'Derek
'I've tried using the recordset to create a temporary table and then use that to update but it's getting over my head
Explicitly declare connection and recordset type. Then Set lines are not required.
Set the lock type argument.
Reference connection object not string variable for opening recordset.
Dim cn As ADODB.Connection, rs As ADODB.Recordset
cn.Open (strConn)
strUpdateqry = "SELECT * FROM tblMedHxInfo WHERE MedNumber = " & Chr(34) & strMedNum & Chr(34)
rs.Open strUpdateqry, cn, adOpenKeyset, adLockOptimistic
rs.Update "Allergies", "Penicillin, Codeine"
Or instead of opening recordset object for insert or update:
Dim cn As ADODB.Connection
cn.Open (strConn)
cn.Execute "UPDATE tblMedHxInfo SET Allergies = 'Penicillin, Codeine' WHERE MedNumber='" & strMedNum & "'"
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.
I have code that is pulling in data from a SQL table, and using VB and a data validation List Box that allows the user to select a criteria then it should pull in the data associated with that criteria: but I am not getting any errors and it is running the code but not pulling in any data. Can someone let me know what I am doing wrong: Here is my example: I select scenario from the Data Validation List Box and get " No Records Returned" here is my code:
Dim conn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim sConnString As String
Dim sSQL As String
Dim ceRg As Worksheet
Set ceRg = ThisWorkbook.Worksheets("RG Schedule")
If ceRg.FilterMode Then
ceRg.ShowAllData
End If
ceRg.Range("A3").ClearContents
' Create the connection string.
sConnString = "Provider=SQLOLEDB;Data Source=SQL\SQLEXPRESS;Initial Catalog=Sample;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
sSQL = "SELECT [ORDER #],[SCENARIO],[LOCATION],[FORM],[STATUS],"
sSQL = sSQL & "CAST([Date Ordered] as date),"
sSQL = sSQL & "[Design],[Cost],"
sSQL = sSQL & "CAST([Critical Obligation Date] as date),"
sSQL = sSQL & "[MGMT_APPROVED],[AUTHORIZATION_Y_N],[CUSTOMER]"
sSQL = sSQL & "FROM [dbo].[vwRG_Schedule]"
sSQL = sSQL & "WHERE [SCENARIO] = '" & Scenario & "' "
sSQL = sSQL & "ORDER BY [ORDER #]"
Set rs = conn.Execute(sSQL)
' Check we have data.
If Not rs.EOF Then
' Transfer result.
ceRg.Range("A3").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
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
First off, I truly apologize if someone promptly points me to a post in which this question was answered. I'm not great at sifting through the boards, but have been searching for about a week. Many threads are similar to my problem, but none exactly mirror what I'm trying to do or the problem I'm having. The closest I've found was posted here. The solution reached there did not solve my issue.
I am trying to update records in an ACCESS 2007 database from an update Excel worksheet using VBA. I have accomplished getting information from ACCESS into Excel, and from Excel into my recordset. Now, I need to update ACCESS with the populated recordset.
Public Sub Read_Spreadsheet()
Dim strSql As String, target_fields As String
Dim fuel_table As String, new_values As String
Dim roww As Integer, coll As Integer
Dim i As Integer, n As Integer, mbrs(32) As Integer
Call Load_Globals
' Configure ADODB connection, command, recordset objects
With cn1
.Provider = "Microsoft.JET.OLEDB.4.0"
.ConnectionString = "Data Source = " & Src_WB_nm & "; " & _
"Extended Properties='Excel 8.0;HDR=Yes;IMEX=1'"
.Open
End With
Set cmd1.ActiveConnection = cn1
cmd1.CommandType = adCmdText
cmd1.CommandText = "SELECT * FROM [" & Src_WS_nm & "$]"
With rs1
.CursorLocation = adUseClient ' used 3 previously
.CursorType = adOpenDynamic ' used 1 previously
.LockType = adLockOptimistic
.Open cmd1
End With
Debug.Print "Excel Connection established; recordset created."
Debug.Print "Fields: " & rs1.Fields.count
Debug.Print rs1.Fields(0).name
Debug.Print rs1.Fields(1).name
'--------------------------------------------------------------------------
With cn2
.Provider = "Microsoft.ACE.OLEDB.12.0"
.ConnectionString = "Data Source = " & Dest_DB
.Open
End With
With rs2
.CursorLocation = adUseClient ' used 3 previously
.CursorType = adOpenDynamic ' used 1 previously
.LockType = adLockOptimistic
End With
Debug.Print "Access connection established."
'--------------------------------------------------------------------------
' NOTE to S.O. readers, Two nested loops are commented out below
' These will eventually loop through an uncertain number of fields
' (~10) and records (~2000) to make all the SQL updates. For debugging,
' I'm just trying to get 1 pass to be successful.
'
' For n = 1 To rs1.RecordCount
' strSql = "SELECT ID, FSERIAL FROM TESTTABLE WHERE ID = 1"
strSql = ""
i = 1
' For i = 1 To rs1.Fields.count - 1
If i <> 1 Then strSql = strSql & ", "
strSql = strSql & " SET [" & rs1.Fields(i).name & "] = " & Chr(39) & rs1.Fields(i).Value & Chr(39)
' Next i
strSql = "UPDATE " & Dest_Table & strSql & " WHERE [ID] = " & rs1.Fields(0).Value
strSql = "UPDATE TESTTABLE SET BATCH = 'B' WHERE ID = 11"
Debug.Print strSql
Set cmd2 = New ADODB.Command
With cmd2
.ActiveConnection = cn2
.CommandType = adCmdText
.CommandText = strSql
.Execute , , adCmdText + adExecuteNoRecords
End With
' CP.Cells(27 + n, 4) = rs1(0)
' CP.Cells(27 + n, 5) = rs1(1)
rs1.MoveNext
Set cmd2 = Nothing
' Next n
' cmd2.CommandText = "SELECT ID, FSERIAL FROM TESTTABLE WHERE ID = 1"
' cmd2.CommandText = "UPDATE TESTTABLE SET BATCH = B WHERE ID = 1"
' Debug.Print cmd2.CommandText
' rs2.Open cmd2
' CP.Cells(28, 4).CopyFromRecordset rs2
Call Close_Connections
End Sub
Both Access & Excel are 2007, and I'm in Windows 7, 32 Bit OS. I'm using the following VBA references: MS ADO Ext. 6.0 for DDL and Security, MS ActiveX Data Ojects Recordset 6.0 Lib, MS ActiveX Objeects 6.1 Lib, MS Access 12.0 Object Lib, OLE Automation. (sorry, I cannot post images yet)
Everything works fine up until the cmd2.execute command (That is the line highlighted by the debugger). If I replace the SQL query with a simple static SELECT and dump it into rs2, it works fine. It's when I try to update only that I get the problem.
The debug.print strSQL command yields"'UPDATE TESTTABLE SET BATCH = 'B' WHERE ID = 11"
I've also tried "UPDATE TESTTABLE SET [BATCH] = 'B' WHERE [ID] = 11" and other permutations, with no success.
The error is : "Run-time error '-2147217904 (80040e10)': No value given for one or more required parameters."
Thank you for your help! I appreciate it very much, and will be sure to rank/flag the solution.
,Mike Shanahan
Your query is ill-formed. I think what you want is:
For i = 1 To rs1.Fields.count - 1
if i<>1 Then strsql = strsql & ", "
strSql = strSql & "[" & rs1.Fields(i).name & "] = " & rs1.Fields(i).Value
Next i
strsql = "UPDATE " & Dest_Table & " SET " & strSql & " WHERE [ID] = " & rs1.Fields(0).Value
Still, this supposes all values are numeric. You'll need to still work it out so that values corresponding to strings are enclosed with single quotes. For example, your test query should be:
.CommandText = "UPDATE TESTTABLE SET BATCH = 'B' WHERE ID = 1"
' ^^^
As suggested in comments, a simple Debug.Print strsql is very helful to debug your queries.