I have an SQL query that I'm running out of Excel. The objective is to run the query and paste the data into a designated location:
Public Function Pull_SQL_Data()
''''On Error GoTo Err:
Worksheets("Data").Select
Range("B7").Select
Do Until ActiveCell = ""
ActiveCell.Offset(1).Select
Loop
Range("B:S", ActiveCell.Offset(-1, 3)).ClearContents
Worksheets("Data").Select
Range("B7").Select
Dim cnPubs As New ADODB.Connection
Dim strConn As String
Dim rstRecordsets As New ADODB.Recordset
Dim intColIndex As Integer
Dim strSQL As Variant
Application.ScreenUpdating = False
Application.Cursor = xlWait
Set cnPubs = New ADODB.Connection
Set rsPubs = New ADODB.Recordset
Set outCell = Sheets("Data").Range("B7")
strSQL = Sheets("SQL").Range("G1")
strConn = "PROVIDER=SQLOLEDB;"
cnPubs.CommandTimeout = 240
strConn = strConn & "DATA SOURCE=CFS-Serversql;INITIAL CATALOG=UserAnalysis;"
strConn = strConn & "INTEGRATED SECURITY=sspi;"
cnPubs.Open strConn
With rsPubs
.ActiveConnection = cnPubs
.Open strSQL, cnPubs, adOpenStatic, adLockReadOnly, adCmdText
Sheets("Data").Range("B7:S500").ClearContents
Sheets("Data").Range("B4").CopyFromRecordset rsPubs
End With
rsPubs.Close
cnPubs.Close
Set rsPubs = Nothing
Set cnPubs = Nothing
Application.Cursor = xlDefault
Exit Function
Err:
MsgBox "The following error has occured-" & vbCrLf & vbCrLf & VBA.Error, vbCritical, "SQL Connection"
MsgBox VBA.Err
Application.Cursor = xlDefault
Worksheets("DWH").Select
Range("A1").Select
End Function
When run I get:
The following error has occurred- Object required" Error code 424.
Why am I experiencing this issue?
Does this work?
Public Function Pull_SQL_Data()
Dim ws As Worksheet
Dim cnPubs As ADODB.Connection
Dim rsPubs As ADODB.Recordset
Dim strConn As String
Dim strSQL As Variant
Set ws = Worksheets("Data")
Set cnPubs = New ADODB.Connection
Set rsPubs = New ADODB.Recordset
strSQL = Sheets("SQL").Range("G1").Value
strConn = "PROVIDER=SQLOLEDB;DATA SOURCE=CFS-Serversql;" & _
"INITIAL CATALOG=UserAnalysis;INTEGRATED SECURITY=sspi;"
cnPubs.Open strConn
rsPubs.Open strSQL, cnPubs, adOpenStatic, adLockReadOnly, adCmdText
ws.Range("B7:S500").ClearContents
If Not rsPubs.EOF Then
ws.Range("B4").CopyFromRecordset rsPubs
Else
MsgBox "No records were returned!"
End If
rsPubs.Close
cnPubs.Close
End Function
Related
I am using Windows 10, Office 2021. I am trying to get data from a access table name User.
Application.ScreenUpdating = False
Dim conn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim rfield As ADODB.Field
Dim accdbfile As String
Dim qry As String, i As Integer
Dim n As Long
Dim cnnstr As String
cnnstr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=D:\excel work\shareholder.accdb;"
Set conn = New ADODB.Connection
Set rst = New ADODB.Recordset
conn.ConnectionString = cnnstr
conn.Open
qry = "SELECT Login,Pwd FROM user;"
With rst
.ActiveConnection = conn
.Source = qry
.LockType = adLockReadOnly
.CursorType = adOpenForwardOnly
End With
**For Each rfield In rst.Fields**
ActiveCell.Value = rfield.Name
ActiveCell.Offset(0, 1).Select
Next
Range("A1").Select
Range("A2").CopyFromRecordset rst
rst.Close
Set rst = Nothing
conn.Close
Set conn = Nothing
Getting an error "Syntax error in From Clause". on ** marked line.
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
I am trying to create a VBA script that will pull the results from a View (SELECT * FROM view_name) from the RecordSet.Source property, but when attempted, my CloseConnection error handler keeps getting caught. I can get results from a table using a simple query like SELECT * FROM tbl_name with no issues.
Below is the code I am using. Note: my Const variable has the Provider and Database information removed.
I guess it really comes down to is it even possible to get results from a View like I would from a table?
Option Explicit
Const ConStrMSSQL As String = _
"Provider=provider_name;Database=database_name;Trusted_Connection=yes;"
Sub test()
Dim formConnect As ADODB.connection
Dim formData As ADODB.recordSet
Dim formField As ADODB.Field
Set formConnect = New ADODB.connection
Set formData = New ADODB.recordSet
formConnect.ConnectionString = ConStrMSSQL
formConnect.Open
On Error GoTo CloseConnection
With formData
.ActiveConnection = formConnect
.Source = "SELECT * FROM v_data_extract_658"
.LockType = adLockReadOnly
.CursorType = adOpenForwardOnly
.Open
End With
On Error GoTo CloseRecordset
Sheets("test").Range("A1").Select
For Each formField In formData.Fields
ActiveCell.Value = formField.Name
ActiveCell.Offset(0, 1).Select
Next formField
Sheets("test").Range("A2").CopyFromRecordset formData
On Error GoTo 0
CloseRecordset:
formData.Close
CloseConnection:
formConnect.Close
End Sub
This is the error message:
run-time error 2147467259 (80004005): unknown token received from SQL Server
I think the big issue here is that you haven't defined a Command Object.
I somewhat put this together "freehand" and for certain, didn't test it but it should get you to where you need to go.
Sub test()
On Error GoTo ErrorHandle:
Dim formConnect As ADODB.Connection
Set formConnect = New ADODB.Connection
formConnect.ConnectionString = ConStrMSSQL
Dim cmd As ADODB.Command
Set cmd = New ADODB.Command
formConnect.Open
With cmd
.ActiveConnection = formConnect
.CommandType = adCmdText
.CommandText = "SELECT * FROM v_data_extract_658"
.CommandTimeout = 30
End With
Dim formData As ADODB.Recordset
Set formData = New ADODB.Recordset
formData.Open cmd, , adOpenStatic, adLockReadOnly
Sheets("test").Range("A1").Select
Dim formField As ADODB.Field
For Each formField In formData.Fields
ActiveCell.value = formField.Name
ActiveCell.Offset(0, 1).Select
Next formField
Range("A2").CopyFromRecordset formData
On Error GoTo 0
Cleanup:
If Not formData Is Nothing Then
If formData.State <> adStateClosed Then formData.Close
Set formData = Nothing
End If
If Not formConnect Is Nothing Then
If formConnect.State <> adStateClosed Then formConnect.Close
Set formConnect = Nothing
End If
Set cmd = Nothing
Exit Sub
ErrorHandle:
MsgBox Err.Description
'Do whatever else is needed to respond to errors.
Resume Cleanup
End Sub
Using Excel & VBA to fetch dta from SLQ Server is quite easy (not always, but these days).
Sub ADOExcelSQLServer()
' Carl SQL Server Connection
'
' FOR THIS CODE TO WORK
' In VBE you need to go Tools References and check Microsoft Active X Data Objects 2.x library
'
Dim Cn As ADODB.Connection
Dim Server_Name As String
Dim Database_Name As String
Dim User_ID As String
Dim Password As String
Dim SQLStr As String
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
Server_Name = "EXCEL-PC\SQLEXPRESS" ' Enter your server name here
Database_Name = "NORTHWND" ' Enter your database name here
User_ID = "" ' enter your user ID here
Password = "" ' Enter your password here
SQLStr = "SELECT * FROM [Customers]" ' Enter your SQL here
Set Cn = New ADODB.Connection
Cn.Open "Driver={SQL Server};Server=" & Server_Name & ";Database=" & Database_Name & _
";Uid=" & User_ID & ";Pwd=" & Password & ";"
rs.Open SQLStr, Cn, adOpenStatic
' Dump to spreadsheet
For iCols = 0 To rs.Fields.Count - 1
Worksheets("Sheet1").Cells(1, iCols + 1).Value = rs.Fields(iCols).Name
Next
With Worksheets("sheet1").Range("a2:z500") ' Enter your sheet name and range here
'.ClearContents
.CopyFromRecordset rs
End With
' Tidy up
rs.Close
Set rs = Nothing
Cn.Close
Set Cn = Nothing
End Sub
As an aside, you can try this as well (please change to suit your specific setup/configuration)...
Sub Working2()
Dim con As Connection
Dim rst As Recordset
Dim strConn As String
Set con = New Connection
strConn = "EXCEL-PC\SQLEXPRESS;Database=Northwind;Trusted_Connection=True"
con.Open strConn
'Put a country name in Cell E1
Set rst = con.Execute("Exec dbo.MyOrders '" & ActiveSheet.Range("E1").Text & "'" & ActiveSheet.Range("E2").Text & "'")
'The total count of records is returned to Cell A5
ActiveSheet.Range("A5").CopyFromRecordset rst
rst.Close
con.Close
End Sub
Please see the link below for more details.
https://www.excel-sql-server.com/excel-sql-server-import-export-using-vba.htm#Excel%20Data%20Export%20to%20SQL%20Server%20Test%20Code
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
I am trying a couple of things and one is to connect an excel workbook with an AS400 to get the description to a part number in our system but trying to keep the connection open or at least until the workbook is closed.
Does anyone have any suggestions?
Public Sub GetPartNumbers()
Dim myConn As ADODB.Connection
Dim myRS As ADODB.Recordset
'' Dim selVal As String
'' Dim selRow As Integer
Set myConn = New ADODB.Connection
myConn.ConnectionString = "Provider=SEQUEL ViewPoint;"
myConn.Open
Set myRS = New ADODB.Recordset
This is how I do it.
Dim myConn As New ADODB.Connection
Dim myRs As New ADODB.Recordset
On Error GoTo ErrorHandler
con.Open "PROVIDER=IBMDAS400;Data Source=999.999.999.999;USER ID= ;PASSWORD= ;"
Set myRs.ActiveConnection = myConn
End
Exit Sub
ErrorHandler:
MsgBox "Can not connect", vbInformation, cHeading
End
End Sub
I can sympathize with you as I had to figure this out as well before I knew much about VBA. Below is a simple connection and loop through results example. And yes, you shouldn't use Activate but for the sake of this example I through it in.
Note that you should clean up the connection at the end. If you use an error handler than make sure you close any open connections before exiting even after an error.
Dim cnn As ADODB.Connection
Dim rst As ADODB.Recordset
Set cnn = New ADODB.Connection
Set rst = New ADODB.Recordset
cnn.Open "PROVIDER=IBMDAS400;Data Source=999.999.999.999;USER ID= ;PASSWORD= ;"
rst.ActiveConnection = cnn
rst.CursorLocation = adUseServer
'Query String (Specific to your database setup)
rst.Source = "SELECT DISTINCT F3002.IXLITM " _
& "FROM WYATT.PRDDTA.F3002 F3002 " _
& "WHERE (F3002.IXKITL='30P') AND (F3002.IXTBM='E')"
rst.Open
Worksheets("Sheet1").Range("A1").Activate
Do Until rst.EOF
ActiveCell.Value = rst.Fields("IXLITM")
rst.MoveNext
ActiveCell.Offset(1, 0).Activate
Loop
'Clean up
rst.Close
Set rst = Nothing
Set cnn = Nothing