Copying ADO recordset into excel worksheet - vba

I'm trying to open a CSV file and query it and return the results into column A of the second worksheet of "ThisWorkbook".
I'm not getting any errors so I do not see why it is not copying the record set into excel.
Dim con As ADODB.Connection
Dim rs As ADODB.Recordset
Set con = New ADODB.Connection
Set rs = New ADODB.Recordset
Dim currentDataFilePath As String
Dim currentDataFileName As String
Dim nextRow As Integer
currentDataFilePath = "C:\Users\M\folder\"
currentDataFileName = "csv-file"
con.Open "Provider=Microsoft.JET.OLEDB.4.0;" & _
"Data Source=" & currentDataFilePath & ";" & _
"Extended Properties=""text;HDR=NO;FMT=Delimited;IMEX=1"""
'rs.ActiveConnection = con
rs.Open "SELECT Name FROM [" & currentDataFileName & ".csv] WHERE Datatype ='TYPE3'",
con
ThisWorkbook.Worksheets("Sheet2").Range("A:A").CopyFromRecordset rs
rs.Close
con.Close
Set rs = Nothing
Set con = Nothing
End Sub

You might refer to the CopyFromRecordset() method.
Based on your code above, after the rs.Open command you would add something like this:
ActiveWorksheet.Range("A1").CopyFromRecordset rs
See more here: http://msdn.microsoft.com/en-us/library/office/ff839240%28v=office.15%29.aspx

Related

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

Read SQL Server query for ADODB.Connection from external file or from variable

I have this Excel VBA code:
Sub ConnectSqlServer()
Dim conn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim sConnString As String
Dim query As String
' Create the connection string.
sConnString = "Provider=SQLOLEDB;Data Source=xxxx.xxx.xxxx.xxx,xxxx;" & _
"Initial Catalog=mydb;" & _
"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("")
ActiveSheet.Range("A2").CopyFromRecordset rs
...
End Sub
all works fine.
The issue is in this section: Set rs = conn.Execute("")
My select statement query is just too big, split it into continuation lines is not practical.
Is there a way of reading the query text from a file, or from a variable?
Thank you very much
Sub ConnectSqlServer()
Dim conn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim sConnString As String
Dim query As String
' Create the connection string.
sConnString = "Provider=SQLOLEDB;Data Source=xxxx.xxx.xxxx.xxx,xxxx;" & _
"Initial Catalog=mydb;" & _
"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
'read SQL from file
query = GetContent("C:\Stuff\myQuery.txt")
Set rs = conn.Execute(query)
ActiveSheet.Range("A2").CopyFromRecordset rs
...
End Sub
'read all file content
Function GetContent(f As String) As String
GetContent = CreateObject("scripting.filesystemobject"). _
opentextfile(f, 1).readall()
End Function
Alternatively, store your SQL in a worksheet cell and read it from there.
You don't have to use continuation lines, you can append the strings and append a vbCrLf character. e.g.
Dim sSQL as string
sSQL = "SELECT" & vbCrLf
sSQL = sSQL & "AField" & vbCrLf
sSQL = sSQL & ",BField" & vbCrLf
sSQL = sSQL & ",(SELECT XField FROM AnotherTable ..........) as XField" & vbCrlf
'and so on and so on
Set rs = conn.Execute(sSQL)
You can build very long SQL statements this way.

VBA: type mismatch -- how to pass ADODB.Recordset object to subroutine?

I encountered a type mismatch error when passing a ADODB.Recordset object to a subroutine. See the code nugget below.
Sub CreateRS()
Dim oCONN As ADODB.Connection
Dim oRS As ADODB.Recordset
Dim strSQL As String
Dim strConn As String
strConn = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & ActiveWorkbook.FullName & ";" & _
"Extended Properties=""Excel 12.0;HDR=Yes;"";"
Set oCONN = New ADODB.Connection
oCONN.Open strConn
strSQL = "SELECT * FROM mytable"
Set oRS = New ADODB.Recordset
oRS.Open strSQL, oCONN
' type mismatch error for the next statement
ProcessRS (oRS)
End Sub
Sub ProcessRS(ByRef RS As ADODB.Recordset)
....
End Sub
Did quite a bit of searches, yet didn't find a correct answer. Can anyone point out what is the right syntax to use here? Thanks!

Setting a connection to an access database in VBA crashes excel

This is the code I use to open a connection to an access database from excel. It used to work for more than a year.
Set dbname = New ADODB.Connection
theconnection = "//xxx.sharepoint.com/sites" & Application.PathSeparator & TARGET_DB
With dbname
.Provider = "Microsoft.ACE.OLEDB.12.0"
.Open theconnection
End With
By trial an error I've come to the conclusion that this line is causing the problem.
Set dbname= New ADODB.Connection
The problem began after an automatic update of my PC
My Excel version 2016 MSO (16.0.7726.1036) 32-bit
Please let me know if you have run also into this problem, and if you know any fix or workaround.
try to uncheck your 'ActiveX Data Objects' references and add them back:
Tools - References
or
use object to define a database:
Dim dbname As Object
Set dbname = CreateObject("ADODB.Connection")
or
if you create connection variable like this:
Dim con as New ADODB.Connection
change it to:
Dim con as ADODB.Connection
Set con = New ADODB.Connection
Maybe
Dim dbname As Object
Set dbname = CreateObject("ADODB.Connection")
theconnection = "//xxx.sharepoint.com/sites" & Application.PathSeparator & TARGET_DB
With dbname
.Provider = "Microsoft.ACE.OLEDB.12.0"
.Open theconnection
End With
I used like this , all code
Dim Rs As Object
Dim strConn As String
Dim i As Integer
Dim strSQL As String
strSQL = "select * from [table] "
strConn = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & ThisWorkbook.FullName & ";" & _
"Extended Properties=Excel 12.0;"
Set Rs = CreateObject("ADODB.Recordset")
Rs.Open strSQL, strConn
If Not Rs.EOF Then
With Ws
.Range("a1").CurrentRegion.ClearContents
For i = 0 To Rs.Fields.Count - 1
.Cells(1, i + 1).Value = Rs.Fields(i).Name
Next
.Range("a" & 2).CopyFromRecordset Rs
End With
End If
Rs.Close
Set Rs = Nothing

Import MDB Table into EXCEL via vba - Need field names/headers

I have this bit of code that I found online that will import access records into excel. strFilePath is the filepath for the MDB and strTableName is the table name I am looking to import
Sub importAccessdata()
Dim cnn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim sQRY As String
Dim strFilePath As String
strFilePath = Sheets("Setup").Range("C2").Value
strTableName = Sheets("Setup").Range("C4").Value
Set cnn = New ADODB.Connection
Set rs = New ADODB.Recordset
cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & strFilePath & ";"
sQRY = "SELECT * FROM " & strTableName & ""
rs.CursorLocation = adUseClient
rs.Open sQRY, cnn, adOpenStatic, adLockReadOnly
Application.ScreenUpdating = False
Sheet3.Range("A1").CopyFromRecordset rs
rs.Close
Set rs = Nothing
cnn.Close
Set cnn = Nothing
Exit Sub
End Sub
All of the records import very fast however I cannot get the field names to populate with them! Is there a simple modification I can do to carry the field names with the data?
This is what I use-
Private Sub PullSummaryData()
Const strDb As String = "C:\db\AccessDatabase.accdb"
Dim rs As ADODB.Recordset
Dim cn As ADODB.Connection
Dim i As Integer
Sheets("Summary").Select
Const strQry As String = "SELECT * FROM [AccessDataTable]"
Set cn = New ADODB.Connection
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strDb & ";"
Set rs = New ADODB.Recordset
With rs
Set .ActiveConnection = cn
.Open strQry
End With
With Sheets("Summary")
For i = 1 To rs.Fields.Count
.Cells(2,i).Value = rs.Fields(i-1).Name 'fields is a 0 based collection
Next i
.Range("A3").CopyFromRecordset rs
End With
rs.Close
cn.Close
End Sub