I have been using this code for some time and it works. As a matter of fact it works with a basic query. It just does not work with my new Stored Procedure. I can run the stored procedure manually. in SSMS and get my results. I thought that the error was when I was not getting data back so I added the . . . If myRS1.EOF Then . . . still getting the 3704 runtime error.
Here is my Excel (2013) Code
Private Sub cmdOK_Click()
Dim myStartDate, myEndDate
Dim myInsuranceCode
Dim objAD, objUser
Dim myDisplayName, myLastRow
Dim myMessage, myStyle, myTitle, myResult
Dim mySQL As String
Dim myConn
Dim myCmd
Dim myRS1
Dim myRange, myNamedRange, myCheckRange As Range
Dim X, Y, z
Dim myPercent, myLowEnd, myHighEnd
Dim myValue1, myValue2, myValue3, myValue4, myValue5, myValue6, myValue7, myValue8
Dim myCheckValue
Dim myHeaderRow, myDataRow, myLastColumn
'SET THESE ACCORDING TO THE REPORT. THE FIRST TWO MIGHT NOT NEED ANY CHANGES
myHeaderRow = 2
myDataRow = 3
myLastColumn = 22
'SETUP DATABASE OBJECTS
Set myConn = New ADODB.Connection
Set myCmd = New ADODB.Command
Set myRS1 = New ADODB.Recordset
Application.StatusBar = True
Application.StatusBar = "Connecting to SQL Server"
'GET DATES FROM TEH FORM AND SET SQL STATEMENT
myStartDate = frmMain.txtStartDate
myEndDate = frmMain.txtEndDate
'RUN INSURANCE STORE PROCEDURE
'SEPERATE THE INSURANCE CODE WITH A |
myInsuranceCode = "S19|S22"
mySQL = "dbo.BMH_rpt_PATIENTS_INSURANCE_LISTING '" & myStartDate & "', '" & myEndDate & "', '" & myInsuranceCode & "'"
'mySQL = "SELECT * FROM dbo.BETHESDA_ADMIT_SOURCE"
'HIDE THE FORM
frmMain.Hide
'GET THE USER THAT IS SIGNED IN
Set objAD = CreateObject("ADSystemInfo")
Set objUser = GetObject("LDAP://" & objAD.UserName)
myDisplayName = objUser.DisplayName
'OPEN CONNECTIONS TO THE DATABASE
myConn.ConnectionString = "Provider=SQLOLEDB;Data Source=mySQLServer;Initial Catalog=myDatabaseName;User ID=user;Password=xxxxxxxx;Connection Timeout=300;"
myConn.Open
'SET AND EXECUTE SQL COMMAND
Set myCmd.ActiveConnection = myConn
myCmd.CommandText = mySQL
myCmd.CommandType = adCmdText
Application.StatusBar = "Running Stored Procedure " & mySQL
myCmd.CommandTimeout = 3000
'OPEN RECORDSET
Set myRS1.Source = myCmd
myRS1.Open
'CHECK TO MAKE SURE WE ARE NOT AT THE BOTTOM OF THE SHEET COULD MEAN THERE WAS NOT DATA LAST TIME.
'THIS SAME CODE WILL REPEAT FOR THE DATA TAB
'*********** DATA *************
'CHECK TO MAKE SURE THERE IS DATA
If myRS1.EOF Then <---- THIS IS THE LINE I AM GETTING THE ERROR
Cells(myDataRow, 1).Value = "No Data Qualifies"
myMessage = "No data qualifing for your request " & mySQL
myTitle = "No Data"
myStyle = vbCritical + vbOKOnly
myResult = MsgBox(myMessage, myStyle, myTitle)
Exit Sub
End If
'SELECT THE SHEET TO CLEAR OUT THE OLD data on DATA
'IF THIS IS NOT SET ON THE SEEHET IT WILL FAIL
Set myTable = Sheets("DATA").ListObjects("DATA")
If Cells(myDataRow, 1).Value <> "" Then
myTable.DataBodyRange.Rows.Delete
End If
'COPY THE DATA TO EXCEL
Application.StatusBar = "Copying the new data."
Sheets("DATA").Cells(myDataRow, 1).CopyFromRecordset myRS1
Cells(1048576, 1).Select
Selection.End(xlUp).Select
myLastRow = ActiveCell.Row
'Application.StatusBar = "Naming the new DATA range"
'ActiveWorkbook.Names.Add Name:=myNamedRange, RefersTo:=Range(Cells(myHeaderRow, 1), Cells(myLastRow, myLastColumn))
myTable.Resize Range(Cells(myHeaderRow, 1), Cells(myLastRow, myLastColumn))
End Sub
*** This is all the VBA Code now. It is failing on the myRS1.EOF line so none of the other code even runs.
As you can see I have two mySQL statements. The first one is not working, but the second one works no issue.
If I run the SP from SSMS or even take the mySQL that is generated it runs fine in SSMS.
Here is the SP
--EXAMPLE
-- dbo.BMH_rpt_PATIENTS_INSURANCE_LISTING '11/01/2020', '11/30/2020', 'S19|S22'
ALTER PROCEDURE [dbo].[BMH_rpt_PATIENTS_INSURANCE_LISTING]
#StartDate AS DATETIME,
#EndDate AS DATETIME,
#Insurance AS VARCHAR(MAX)
AS
/** GET THE INSURANCE CODES **/
SELECT VALUE
INTO #INSURANCE
FROM STRING_SPLIT(#Insurance, '|')
/** GET THE PATIENTS FOR THE LIST **/
SELECT vv.pt_id AS 'Patient Account',
vv.alt_med_rec_no AS 'MRN'
FROM smsdss.vst_v AS vv
WHERE vv.pyr_cd IN (SELECT * FROM #INSURANCE)
AND vv.start_full_date BETWEEN #StartDate AND #EndDate
AND vv.tot_bal_amt <> 0
Related
I have a VBA sub in Excel. It needs to call a SQL Server procedure, and display the results of the call in a message box. (Mainly, because I'm maintaining someone else's code - otherwise, I wouldn't be using Excel.)
I create my SQL statement to call the procedure. I have subs that open the connection. But I'm still missing something in the process of showing the results of that procedure call.
Here's what I have so far:
Dim Today As Date
Dim result As Date
Dim sSQLStatement As String
Dim strDate As String
Dim Recordset As ADODB.Recordset
Today = DateTime.Now()
result = DateSerial(Year(Today), Month(Today) - 1, 1)
strDate = Year(result) & "-" & Format(Month(result), "00") & "-" & Format(Day(result), "00")
DBOpen
sSQLStatement = "set nocount on; EXEC [MySchema].[dbo].[MyProcedure] #END_DATE = N'" & strDate & "'"
MsgBox sSQLStatement
Dim i As Long
Dim Ary
Dim strMsg As String
Set Recordset = New ADODB.Recordset
With Recordset
.ActiveConnection = cnPubs 'this is defined elsewhere, used in the DBOpen call, and works
'I can call the execute and it works, but it fails here when I try to assign the results to the recordset
Recordset = cnPubs.Execute(sSQLStatement)
'I found this online and don't know yet if it works. I have to get past the statement above first.
If Not Recordset.EOF Then
Ary = Recordset.GetRows
For i = 0 To UBound(Ary, 2)
If i = 0 Then
strMsg = Ary(0, i)
Else
strMsg = strMsg & ", " & Ary(0, i)
End If
Next i
MsgBox strMsg, , UBound(Ary, 2) + 1 & " records"
End If
.Close
End With
DBClose
So, if I call the cnPubs.Execute(sSQLStatement) by itself, I can tell it is running. I open and close the connection just fine. But it should be returning a set of several rows, and I need to display that. I don't want to write those to the spreadsheet anywhere - they should just be displayed in a message box.
Change
Recordset = cnPubs.Execute(sSQLStatement)
to
recordset.open sSQLStatement, cnPubs
I have a couple macros to make calls to SSMS 2014 to run a query and return the results in a defined cell in my worksheet. They work successfully, but when I try to use certain queries with temp tables I get the following error message:
I have researched online and the best answer I can find is to add SET NOCOUNT ON at the beginning of my query. I tried that, and still got the same message.
The piece of code that the Debug brings me to is as follows:
bqr.Range("B6").CopyFromRecordset rst
The meat and potatoes of my code, along with the variable setups that matter, is as follows:
Dim cnn As New ADODB.Connection
Dim rst As New ADODB.Recordset
Dim ConnectionString As String
Dim StrQuery As String
Dim SOURCE As String
Dim DATABASE As String
Dim QUERY As String
Dim intColIndex As Integer
Dim sDate As String
Dim eDate As String
Dim qt As Worksheet
Dim qtr As Worksheet
Dim bqr As Worksheet
Dim bp As Worksheet
ConnectionString = "Provider=SQLOLEDB;Data Source=" & SOURCE & "; Initial Catalog=" & DATABASE & "; Integrated Security=SSPI;"
cnn.Open ConnectionString
cnn.CommandTimeout = 900
StrQuery = QUERY
rst.Open StrQuery, cnn
bqr.Range("B6").CopyFromRecordset rst
For intColIndex = 0 To rst.Fields.Count - 1
Range("B5").Offset(0, intColIndex).Value = rst.Fields(intColIndex).Name
Next
The most confusing part is that the error suggests that my rst recordset is closed, even though it is opened just before I use the CopyFromRecordset
I've tried adding DROP TABLE at the end of my query, the SET NOCOUNT ON function at the beginning, and even tested some smaller simple temp tables as tests.
For example, I set my QUERY variable to:
QUERY = "CREATE TABLE #Test1 (TestID INT, TestValue VARCHAR(20))"
QUERY = QUERY + " INSERT INTO #Test1"
QUERY = QUERY + " VALUES (1, 'Pass'), (2, 'Fail'), (3, 'Try Again')"
QUERY = QUERY + " SELECT * INTO #Test2 FROM #Test1 WHERE TestID = 1"
QUERY = QUERY + " SELECT * FROM #Test2"
Then ran the code to extract and past into Excel, and it worked.
Therefore, I am stumped. Maybe there is a limit to how long the query can be? Right now it's 180 lines long, so it's pretty big...
Any suggestions are appreciated!
EDIT: Full macro below (less the actual query):
Private Sub CommandButton1_Click()
If TextBox1.Value = "i.e. 20160101" Or TextBox2.Value = "i.e. 20160131" Then
MsgBox "Please fill out all fields before proceeding"
ElseIf Len(TextBox1.Value) <> 8 Or Len(TextBox2.Value) <> 8 Or Not IsNumeric(TextBox1.Value) Or Not IsNumeric(TextBox2.Value) Then
MsgBox "Please use correctly formatted Datekeys (i.e. yyyymmdd)"
Else
Application.DisplayAlerts = False
Sheets(ActiveWorkbook.Sheets.Count).Select
While ActiveSheet.Name <> "[worksheet I want to keep]"
ActiveSheet.Delete
Sheets(ActiveWorkbook.Sheets.Count).Select
Wend
Dim cnn As New ADODB.Connection
Dim rst As New ADODB.Recordset
Dim ConnectionString As String
Dim StrQuery As String
Dim SOURCE As String
Dim DATABASE As String
Dim QUERY As String
Dim intColIndex As Integer
Dim sDate As String
Dim eDate As String
Dim qtr As Worksheet
Dim bqr As Worksheet
Dim bp As Worksheet
Set qtr = Sheets([sheet name])
Sheets.Add after:=qtr
Set bqr = ActiveSheet
bqr.Name = "[sheet name]"
Sheets.Add after:=bqr
Set bp = ActiveSheet
bp.Name = "[sheet name]"
SOURCE = "[server]"
DATABASE = "[database]"
sDate = UserForm1.TextBox1.Value
eDate = UserForm1.TextBox2.Value
QUERY = "[beginning of query]"
QUERY = QUERY + " [more query here]" 'This gets repeated a lot for each additional line in the query'
qtr.Select
Range("B6").Select
While ActiveCell.Value <> ""
QUERY = QUERY + " " + ActiveCell.Value
ActiveCell.Offset(1, 0).Select
Wend
QUERY = QUERY + " [more query here]" 'This gets repeated a lot for the remaining lines in the query'
ConnectionString = "Provider=SQLOLEDB;Data Source=" & SOURCE & "; Initial Catalog=" & DATABASE & "; Integrated Security=SSPI;"
cnn.Open ConnectionString
cnn.CommandTimeout = 2000
StrQuery = QUERY
rst.Open StrQuery, cnn
bqr.Range("B6").CopyFromRecordset rst
For intColIndex = 0 To rst.Fields.Count - 1
Range("B5").Offset(0, intColIndex).Value = rst.Fields(intColIndex).Name
Next
End If
Application.DisplayAlerts = True
End Sub
Start your T-SQL query with set nocount on;
QUERY = "set nocount on;"
QUERY = QUERY & "declare #Test1 table (TestID INT, TestValue VARCHAR(20))"
QUERY = QUERY & " INSERT INTO #Test1"
QUERY = QUERY & " VALUES (1, 'Pass'), (2, 'Fail'), (3, 'Try Again')"
QUERY = QUERY & " SELECT * FROM #Test1 WHERE TestID = 1"
Then it should work. The next example will also work and is a bit closer to your example (yet using table variables).
set nocount on;
declare #Test1 table (TestID INT, TestValue VARCHAR(20))
declare #Test2 table (TestID INT, TestValue VARCHAR(20))
INSERT INTO #Test1
VALUES (1, 'Pass'), (2, 'Fail'), (3, 'Try Again')
insert into #Test2
select *
from #Test1 WHERE TestID = 1
select * from #Test2
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
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()