I'm trying to query a table in Microsoft Excel using VBA. I've written up some code to try and accomplish this task, but I keep getting a run-time error '1004' saying it's a General ODBC error. I'm not sure what I need to do to get this code to run properly so I can query this table.
I'm using SQL Server Express, the server I'm connecting to: .\SQLEXPRESS
Database:
Databaselink
Querying the products table
VBA Code:
Sub ParameterQueryExample()
'---creates a ListObject-QueryTable on Sheet1 that uses the value in
' Cell Z1 as the ProductID Parameter for an SQL Query
' Once created, the query will refresh upon changes to Z1.
Dim sSQL As String
Dim qt As QueryTable
Dim rDest As Range
'--build connection string-must use ODBC to allow parameters
Const sConnect = "ODBC;" & _
"Driver={SQL Server Native Client 10.0};" & _
"Server=.\SQLEXPRESS;" & _
"Database=TSQL2012;" & _
"Trusted_Connection=yes"
'--build SQL statement
sSQL = "SELECT *" & _
" FROM TSQL2012.Production.Products Products" & _
" WHERE Products.productid = ?;"
'--create ListObject and get QueryTable
Set rDest = Sheets("Sheet1").Range("A1")
rDest.CurrentRegion.Clear 'optional- delete existing table
Set qt = rDest.Parent.ListObjects.Add(SourceType:=xlSrcExternal, _
Source:=Array(sConnect), Destination:=rDest).QueryTable
'--add Parameter to QueryTable-use Cell Z1 as parameter
With qt.Parameters.Add("ProductID", xlParamTypeVarChar)
.SetParam xlRange, Sheets("Sheet1").Range("Z1")
.RefreshOnChange = True
End With
'--populate QueryTable
With qt
.CommandText = sSQL
.CommandType = xlCmdSql
.AdjustColumnWidth = True 'add any other table properties here
.BackgroundQuery = False
.Refresh
End With
Set qt = Nothing
Set rDest = Nothing
End Sub
I found this Stack Overflow question with a Google search. It does not look like anyone has tried answering it, so here's what I ended up doing. Instead of using "QueryTable", use an ADO command object as done in this MSDN article.
MSDN Example:
Dim Conn1 As ADODB.Connection
Dim Cmd1 As ADODB.Command
Dim Param1 As ADODB.Parameter
Dim Rs1 As ADODB.Recordset
Dim i As Integer
' Trap any error/exception.
On Error Resume Next
' Create and Open Connection Object.
Set Conn1 = New ADODB.Connection
Conn1.ConnectionString = "DSN=Biblio;UID=admin;PWD=;"
Conn1.Open
' Create Command Object.
Set Cmd1 = New ADODB.Command
Cmd1.ActiveConnection = Conn1
Cmd1.CommandText = "SELECT * FROM Authors WHERE AU_ID < ?"
' Create Parameter Object.
Set Param1 = Cmd1.CreateParameter(, adInteger, adParamInput, 5)
Param1.Value = 5
Cmd1.Parameters.Append Param1
Set Param1 = Nothing
' Open Recordset Object.
Set Rs1 = Cmd1.Execute()
Related
I understand the report recordset property cant be connected too.
However I want/need to do something like:
Private Sub testLoad()
Dim cmd As ADODB.Command
Set cmd = New ADODB.Command
cmd.ActiveConnection = gcn
cmd.CommandType = adCmdStoredProc
cmd.CommandText = "mysp_ProofofJobScott"
'Your parameters
cmd.Parameters("#StartJob").value = 1234
cmd.Parameters("#Cmonth").value = "February 2020"
Set Me.Recordset = cmd.Execute
End Sub
Which would work fine...if I could bind a report to a recordset.
I am already using a variation of this for all my forms, and would like to be consistent in my approach.
I got thinking is there a way to use the cmd.execute to populate a temporary table, become a source for the recordsource or some other work around?
Easy and fast is the Passthrough query, but you have to take care on passed arguments to be valid as you just concat sp name with them.
Consider change cMonth to a date, then evaluate month in sp.
Code to create PT query:
Private Sub CreatePTProofofJobScott(StartJob As Long, cMonth As String)
Const QueryDefName As String = "PTProofofJobScott"
With CurrentDb
Dim QdfExists as Boolean
Dim qdf As DAO.QueryDef
For Each qdf In .QueryDefs
If qdf.Name = QueryDefName Then
QdfExists = True
Exit For
End If
Next
If Not QdfExists Then
.CreateQueryDef(QueryDefName)
End If
With .QueryDefs(QueryDefName)
.Connect = "ODBC;DSN=yourDsnToSqlServer" 'or Conn-String https://www.connectionstrings.com/microsoft-odbc-driver-17-for-sql-server/
.SQL = "EXEC mysp_ProofofJobScott " & StartJob & ", '" & cMonth & "'"
End With
End With
End Sub
Use in Report_Open event with wanted args:
Private Sub Report_Open(Cancel As Integer)
CreatePTProofofJobScott Split(Me.OpenArgs,";")(0), Split(Me.OpenArgs,";")(1)
Me.RecordSource = "PTProofofJobScott"
End Sub
Pass args to OpenArgs on open cmd
DoCmd.OpenReport "yourReport",acViewPreview,,,,"1234;February 2020"
For future development, you should have a look at SSRS as FoggyDay noted
I want to be able to execute a SQL Server stored procedure from MS Access VBA, in such a way that I can read (1) all the resulting result sets, not just the first one; and (2) any messages produced by PRINT statements or similar.
I have a test stored procedure with one input parameter, which produces 3 distinct result sets and about 90 messages. It calls several sub-stored procedures, I can EXEC it perfectly well from SSMS, but it isn’t clear (to me) how best to do it from Access VBA. I have tried the following so far:
DAO. Using SQL pass-through queries, I can get a lot of what I want in DAO, though it is a little clunky. It returns the first of the 3 result sets as a recordset, and by using the LogMessages attribute I can get a table (“Admin – NN”) containing the emitted messages.
ADO. Using Connection and Command objects, I can obtain a single recordset representing the first result set from the stored procedure. However, I can’t seem to persuade it to produce anything but a forward-only recordset. Regarding messages, at one point, all of them (at least, the first 127 of the approx. 150 I expected) were going into the connection’s Errors collection (!), but when I cut the number down to about 90, none of them appeared anywhere at all that I could find.
What I really want, as I said at first, is the output from all result sets, plus the messages. Is this possible?
Here is a listing of the routine I am currently using for executing a stored procedure :
Function ExecuteStoredProcedureADO(SPName As String, Connect As String, ReturnsRecords As Boolean, _
ParamArray Params() As Variant) As ADODB.Recordset
' v1.0 2018/06/26
' execute stored procedure SPName on a SQL Server database specified by the string in Connect
Dim strErr As String
Dim i As Integer
Dim lngRecsAffected As Long
Dim cnn As ADODB.Connection
Dim cmd As ADODB.Command
Dim errCurr As ADODB.Error
Dim rst As ADODB.Recordset
On Error GoTo Catch
Set ExecuteStoredProcedureADO = Nothing
Set cnn = New ADODB.Connection
cnn.Errors.Clear
cnn.mode = adModeRead
cnn.CommandTimeout = 300
cnn.Open Connect
Set cmd = New ADODB.Command
With cmd
.ActiveConnection = cnn
.CommandText = SPName
.CommandType = adCmdStoredProc
For i = 0 To UBound(Params) Step 4
.Parameters.Append .CreateParameter(Params(i), Params(i + 1), adParamInput, Params(i + 2), Params(i + 3))
Next i
Set rst = New ADODB.Recordset
rst.CursorType = adOpenStatic
If ReturnsRecords Then
'''Set rst = .Execute(lngRecsAffected)
rst.Open cmd, , adOpenStatic, adLockReadOnly
Else
Set rst = .Execute(, , adExecuteNoRecords)
End If
End With
If ReturnsRecords Then Set ExecuteStoredProcedureADO = rst
Final:
On Error Resume Next
If Len(strErr) > 0 Then Call AppendMsg(strErr)
Set rst = Nothing
Set cmd = Nothing
Exit Function
Catch:
If cnn.Errors.Count > 0 Then
With cnn
For Each errCurr In cnn.Errors
strErr = strErr & "Error " & errCurr.Number & ": " & errCurr.Description _
& " (" & errCurr.Source & ")" & vbCrLf
Next errCurr
strErr = Left(strErr, Len(strErr) - 2) ' truncate final CRLF
End With
Else
strErr = "Error " & Err.Number & ": " & Err.Description & " (" & Err.Source & ")"
End If
MsgBox strErr, vbOKOnly, gtitle
Resume Final
End Function
Addendum: Regarding the multiple result sets, I am hoping that http://msdn.microsoft.com/en-us/library/ms677569%28VS.85%29.aspx
will be of some help.
To shamelessly piggy-back off of #Erik, you want to create a new class that will handle your processing. Something like cProcedureHandler. Within this class, you need to declare an ADODB.Connection object using the WithEvents keyword:
Dim WithEvents cn As ADODB.Connection
Then, you need to write a InfoMessage event handler that will take care of the multiple print statements. Information about the InfoMessage event can be found here, and using the connection's Errors collection can be found here. So you'll end up with something like this:
Private Sub cn_InfoMessage(ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, ByVal pConnection As ADODB.Connection)
Dim err As ADODB.Error
Debug.Print cn.Errors.Count & " errors"
For Each err In cn.Errors
' handle each error/message the way you need to.
Debug.Print err.Description
Next err
End Sub
Since you've taken care of the code to handle multiple messages, now you just need to handle the multiple recordsets, which is explained pretty well in the link you provided. One thing I noticed was that the example link used rs is nothing as the check for when there were no more recordsets, which didn't work for me. I had to use the rs State property. So I ended up with this:
Public Sub testProcedure()
Dim cmd As ADODB.Command
Dim rs As ADODB.Recordset
Dim recordSetIndex As Integer
Set cn = modData.getConnection
Set cmd = New ADODB.Command
cmd.ActiveConnection = cn
cmd.CommandType = adCmdStoredProc
cmd.CommandText = "dbo.sp_foo"
Set rs = cmd.Execute
recordSetIndex = 1
Do Until rs.State = ObjectStateEnum.adStateClosed
Debug.Print "contents of rs #" & recordIndex
Do Until rs.EOF
Debug.Print rs.Fields(0) & rs.Fields(1)
rs.MoveNext
Loop
Set rs = rs.NextRecordset
recordSetIndex = recordIndex + 1
Loop
cn.Close
Set rs = Nothing
Set cn = Nothing
Set cmd = Nothing
End Sub
Then, when you're ready to run your SP from VBA, just do something like this:
set obj = new cProcedureHandler
obj.testFooProcedure
Another thing (you probably have already done this): Make sure your actual stored procedure in SQL Server sets nocount on.
I am relatively experienced in VBA coding, but I am totally new in MS SQL server 2008.
I am trying to export an Excel table like below to a SQL server:
A B C D E
1 Name Year ID
2 Jill 2015 17
3 Jack 2012 13
4 Mike 1999 25
5
After activating ADO and DAO in the tools, it fixed the error "User Defined Type Not Defined" for the line Dim rs As New ADODB.Recordset. But now I get an error for the line Set dbclass = New clsDB. I don't understand what is wrong. The same definition structure works in another Workbook.
Private Sub Transtable()
Dim connOk As Boolean
Dim MyWorkBook As Workbook
Dim CurSheet As Worksheet
Dim listObj As ListObject
Dim rs As New ADODB.Recordset
' Dim dbclass As New clsDB ' both description leads to the same "User Undefined" error
' Dim dbclass As New ADODB.clsDB
Set dbclass = New clsDB
dbclass.Database = "Tables"
dbclass.ConnectionType = SqlServer
dbclass.DataSource = "E72b1783"
dbclass.UserId = Application.UserName
connOk = dbclass.OpenConnection(False, True)
If connOk = False Then
MsgBox "Connection not successfull"
Else
MsgBox "Connection successfull"
End If
tableName = "TableName1"
Set CurSheet = Sheet2
Set listObj = CurSheet.ListObjects(tableName) 'Table Name
'get range of Table
HeaderRange = listObj.HeaderRowRange.Address
DataRange = listObj.DataBodyRange.Address
dbclass.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & ThisWorkbook.FullName & ";" & _
"Extended Properties=""Excel 12.0;HDR=Yes;IMEX=1"";"
strSQL = "SELECT * FROM [" & ws.Name & "$" & Replace(DataRange, "$", "") & "];"
rs.Open strSQL, dbclass, adOpenStatic, adLockReadOnly
arrData = rs.GetRows
rs.Close
dbclass.Close
Set rs = Nothing
Set dbclass = Nothing
Set listObj = Nothing
Set CurSheet = Nothing
End Sub
Make sure the Data Access Objects library (DAO) is checked in the Tools. Also look at the ActiveX Data Objects library (ADO) in the list. References list in the VBA Editor's menu/ribbon. (The specific name of the library can be different in different versions of Access)
I am trying to write an Exce-Vba code for SQL connection. The code, first will open the connection to the server, then it will copy a 4 columns of table (Range("C22:G81")) from my Excel-sheet to the SQL-server (I am only trying to send numerical table now as a test, I don't send any column name)
I have been trying to solve a "Application Defined or Object Defined" error quite long time. I get the error for the connection string strCon = "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & strName & ";Extended Properties=""Excel 12.0;"
I even tried with another version with password option like strCon = "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & strName & ";Extended Properties=""Excel 12.0; Jet OLEDB:Database Password='passwd';"
But I get the same error. I am quite new in SQL-coding. I wonder if I am missing something important.
Lasly, I don't know if it is related to this error, but I manually created 4 columns in the SQL server for my 4 columns in the Excel. Do I need to write something specific that those 4 columns in the Excel-sheet will find the right columns in the SQL-server?
Thanks in advance...
The code:
Private Sub inlasning()
Dim MyWorkBook As Workbook
Dim rs As New ADODB.Recordset
Dim conn As New ADODB.Connection
Dim ServerName As String, DataBaseName As String, strSQL As String
Set conn = New ADODB.Connection
ServerName = "E45c7642"
DataBaseName = "Tables"
' Specify the OLE DB provider
conn.Provider = "sqloledb"
' Set SQLOLEDB connection properties
conn.Properties("Data Source").Value = ServerName
conn.Properties("Initial Catalog").Value = DataBaseName
' Windows NT authentication.
conn.Properties("Integrated Security").Value = "SSPI"
conn.Open
Dim ValidSheet As Worksheet
Dim HeaderRange As Range
Dim DataRange As Range
Dim ColRange As Range
Dim LastRange As Range
Dim strName As String, strCon As String
strName = ThisWorkbook.FullName
Application.ScreenUpdating = False
Set ValidSheet = ThisWorkbook.Sheets("Sheet2") '
Set HeaderRange = ValidSheet.Range("C20:G21")
Set ColRange = HeaderRange.Find(TheHeader, , , xlWhole)
Set LastRange = ColRange.End(xlDown)
Set DataRange = ValidSheet.Range("C22:G81") ' This is what I am trying to transfer, only numeric values without column names
strCon = "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & strName _
& ";Extended Properties=""Excel 12.0;"
conn.Open strCon
strSQL = "SELECT * FROM [" & ValidSheet.Name & "$" & Replace(DataRange, "$", "") & "];"
rs.Open strSQL, dbclass, adOpenStatic, adLockReadOnly
arrData = rs.GetRows
rs.Close
conn.Close
Set rs = Nothing
Set conn= Nothing
Set ValidSheet = Nothing
End Sub
After getting the same error for the "connection string", I changed the strategy, and I used dbclass procedure to open a connection. So the new code is like below. (I found this coding from a guy, but he is on vacation now, so I can't ask him).
It gets connection (dbclass) properties automatically, which are saved in the main ThisWorkbook. This code doesn't give any error at all, but it doesn't copy the column from the Excel to the database. I tried different versions for the sql-query, like SQL = .... VALUES('result') or SQL = .... VALUES(result), but there is no result again, without error.
Private Sub Testing_Click()
Dim FindColValues() As Double
Dim ValidBook As Workbook
Dim ValidSheet As Worksheet
Dim DataRange As Range
Dim dataa As Range
Application.ScreenUpdating = False
TheSheet = "Sheet2"
Set ValidSheet = Worksheets(TheSheet)
Set DataRange = ValidSheet.Range("C21:C81")
' Below creating an array "result(it)" from the seleced range.
For Each dataa In DataRange
ReDim Preserve result(it)
result(it) = dataa.Value
it = it + 1
Next
' Below is just an alternative array for "in case"
arrData = ValidSheet.Range("C22:G81").Value
SQL = "INSERT INTO Table_test (Column1) VALUES ('result()');"
dbclass.ExecuteSQL SQL
End Sub
Below is dbclass connection properties which is read automatically by the other function:
Private Sub Workbook_Open()
Dim connOk As Boolean
Dim rs As New ADODB.Recordset
Dim MyWorkBook As Workbook
Dim CurSheet As Worksheet
Set dbclass = New clsDB
dbclass.Database = "Tables"
dbclass.ConnectionType = SqlServer
dbclass.DataSource = "E45c7642"
dbclass.UserId = Application.UserName
connOk = dbclass.OpenConnection(False, True)
If connOk = False Then
MsgBox "Cannot connect"
Else
MsgBox "The server is connected"
End If
End Sub
Finally I found the problem for my second code. As I wrote before, in my alternative code (second code), I didn't get any error at all in VBA, but it didn't save my table into the server.
Now I know the reason, because my real value was in "comma" format, but the server saved the value in "dot" format. So I added Str(value) to convert the "comma" value to the "dot" value, and it works now:
....
SQL = "INSERT INTO Table_test (Column1) VALUES (" & Str(result(1)) & ")"
dbclass.ExecuteSQL SQL
End Sub
I am relatively experienced in VBA coding, but I am totally new in MS SQL server 2008.
I am trying to export an Excel table like below to a SQL server:
A B C D E
1 Name Year ID
2 Jill 2015 17
3 Jack 2012 13
4 Mike 1999 25
5
My code below, first creates and opens a connection, then creates a table from the Excel-sheet (Sheet2), then it copies this table to my SQL-server.
However, I am getting error like "Application-defined or object-defined error" for the code-line MyWorkBook.CurSheet.ListObjects.Add(xlSrcRange, Range("A1:B4"), , xlYes).Name = "Table1" where I am trying to define Table1 which is read from the Range("A1:B4")
The interesting point I found the same code-line from several different questions, and I think it should work as it is. Does anyone have any idea?
Private Sub Transtable()
Dim connOk As Boolean
Dim MyWorkBook As Workbook
Dim CurSheet As Worksheet
Dim listObj As ListObject
Dim rs As New ADODB.Recordset
Dim dbclass As New ADODB.Connection
Dim ServerName As String, DataBaseName As String, strSQL As String
Set dbclass = New ADODB.Connection
ServerName = "E43b0784"
DataBaseName = "Tables"
' Specify the OLE DB provider.
dbclass.Provider = "sqloledb"
' Set SQLOLEDB connection properties.
dbclass.Properties("Data Source").Value = ServerName
dbclass.Properties("Initial Catalog").Value = DataBaseName
' Windows NT authentication.
dbclass.Properties("Integrated Security").Value = "SSPI"
dbclass.Open
Set MyWorkBook = ActiveWorkbook
Set CurSheet = MyWorkBook.Sheets("Sheet2")
'Create Table in Excel VBA
CurSheet.ListObjects.Add(xlSrcRange, Range("A1:B4"), , xlYes).Name = "Table1"
Set listObj = CurSheet.ListObjects("Table1") 'Table Name
'get range of Table
HeaderRange = listObj.HeaderRowRange.Address
DataRange = listObj.DataBodyRange.Address
dbclass.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & ThisWorkbook.FullName & ";" & _
"Extended Properties=""Excel 12.0;HDR=Yes;IMEX=1"";"
strSQL = "SELECT * FROM [" & CurSheet.Name & "$" & Replace(DataRange, "$", "") & "];"
rs.Open strSQL, dbclass, adOpenStatic, adLockReadOnly
arrData = rs.GetRows
rs.Close
dbclass.Close
Set rs = Nothing
Set dbclass = Nothing
Set listObj = Nothing
Set CurSheet = Nothing
End Sub
CurSheet is not a member of MyWorkBook. CurSheet is already a fully-qualified sheet object on its own. It doesn't need to be qualified with a workbook object.
Set MyWorkBook = ActiveWorkbook
Set CurSheet = Sheet2
'Create Table in Excel VBA
MyWorkBook.CurSheet.ListObjects... ' Error
Maybe this is what you meant:
Set MyWorkBook = ActiveWorkbook
Set CurSheet = MyWorkbook.Sheets("Sheet2")
'Create Table in Excel VBA
CurSheet.ListObjects... ' Correct