How to load a Range in Excel into MSSQL using VBA - sql-server

I'm trying to load a data range from Excel into a DB.
The code that I have is the following:
Sub InsertARange()
Dim cnt As ADODB.Connection
Dim rst As ADODB.Recordset
Dim stCon As String, stSQL As String
Set cnt = New ADODB.Connection
Set rst = New ADODB.Recordset
stCon = "Provider=SQLOLEDB.1;Password=xxx;Persist Security Info=True;User ID=xxx;Initial Catalog=SSCReporting;Data Source=cra-uk-infra-sql;Use Procedure for Prepare=1;Auto Translate=True;Packet Size=4096;Workstation ID=xxx;Use Encryption for Data=False;Tag with column collation when possible=False"
cnt.ConnectionString = stCon
stSQL = "INSERT INTO _sqlTest select * from [MacroSQL$A1:D10]"
cnt.Open
rst.Open stSQL, cnt, adOpenStatic, adLockReadOnly, adCmdText
If CBool(rst.State And adStateOpen) = True Then rst.Close
Set rst = Nothing
If CBool(cnt.State And adStateOpen) = True Then cnt.Close
Set cnt = Nothing
End Sub
With this code I get an error message "Invalid object name MacroSQL$A1:D10"
I tried also selecting the tab name in the stSQL string as
stSQL = "INSERT INTO _sqlTest select * from [DB_RangeUpload$]
I was using the code samples that appear here, but maybe this is only for select queries and does not work with insert queries.
Any ideas on how to make it work?

Related

ADO connection from Excel to SQL Server executes but returns no records

I have a spreadsheet from which I want to pass SQL script to my SQL server Database, both to retrieve records and run stored procedures.
Here's my code:
Sub ApendPickListData()
Dim SqlConn As New ADODB.Connection
Dim listID As Integer
Dim lists As New ADODB.Recordset
Dim SQLstr As String
SqlConn.ConnectionString = "Provider = 'SQLOLEDB';Server=MyServer\SQLEXPRESS;Database=MyDatabase;Uid=Username;PWD=Password;"
SqlConn.Open
'The following execution of a stored procedure works
SqlConn.Execute "Exec spListsInsertNew #Type = 'Picking', #Date ='" & Date & "'"
SQLstr = "SELECT ItemList.ItemNumber from ItemList"
'This method doesn't work
With lists
.ActiveConnection = SqlConn
.Source = SQLstr
.Open
Debug.Print .RecordCount
'prints -1 in the immediate window - no records
End With
'Neither does this method
Set lists = SqlConn.Execute(SQLstr)
Debug.Print lists.RecordCount
'prints -1 in the immediate window - no records
SqlConn.Close
End Sub
I feel like I'm missing something obvious. I've searched this site and others, found examples where this code should work. I've tested the select statement in SSMS and it works as expected.
Any help would be appreciated!
The code that worked was from Mark Balhoff's comment. Here it is:
Sub ApendPickListData()
Dim SqlConn As New ADODB.Connection
Dim listID As Integer
Dim lists As New ADODB.Recordset
Dim SQLstr As String
SqlConn.ConnectionString = "Provider = 'SQLOLEDB';Server=Myserver\SQLEXPRESS;Database=MyDB;Uid=Username;PWD=Password;"
SqlConn.Open
SQLstr = "select dbo.ItemList.ItemNumber from dbo.ItemList"
With lists
.ActiveConnection = SqlConn
.Source = SQLstr
.CursorLocation = adUseClient 'This was the key!
.Open
Debug.Print .RecordCount
End With
SqlConn.close
End Sub

Change the text in a field with a VBA function

I'm currently working on a database in Access which has a table (Pro_Cons) who compares the pros and cons of different product-types. This table has 3 columns; Type (Product_type), Pros (Pro) and Cons.
For each of product-type I created a form which includes the pro- and the cons-field of the according type out of this table.
For adding new text to this fields I'm creating a VBA-function which is triggered by a button-click.
Because nothing worked as supposed to, I created the following function, which should only replace the Pro -field of the product type1 to change1.
Access doesnt throw an error, but nothing changes in the table.
Has someone an idea whats happening here?
Sub Change_Pos_Inf()
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim strSQL As String
Dim strSensortyp As String
Dim strNew As String
Set db = CurrentDb()
strProduct_type = "type1"
strNew = "change1"
strSQL = "SELECT Pro FROM Pro_Cons WHERE Product_type='strProduct_type';"
Set rst = db.OpenRecordset(strSQL, dbOpenDynaset)
With rst
If .RecordCount > 0 Then
.MoveFirst
.Edit
!Pro.Value = strNew
.Update
End If
End With
End Sub
I think your literal should be changed to reference a form control:
strSQL = "SELECT Pro FROM Pro_Cons WHERE Product_type='strProduct_type';"
Changes to:
strSQL = "SELECT Pro FROM Pro_Cons WHERE Product_type='" & Me!strProduct_type &
"'";
Please try the following code. It corrects your WHERE clause:
Sub Change_Pos_Inf()
Dim db As DAO.Database
Dim rst As DAO.Recordset
Dim strSQL As String
Dim strSensortyp As String
Dim strNew As String
Set db = CurrentDb()
strProduct_type = "type1"
strNew = "change1"
strSQL = "SELECT Pro FROM Pro_Cons WHERE Product_type= '" & strProduct_type & "';"
Set rst = db.OpenRecordset(strSQL, dbOpenDynaset)
With rst
If Not rst.EOF Then
.Edit
!Pro.Value = strNew
.Update
Else
MsgBox "No Record found!!"
End If
End With
rst.Close
Set rst = Nothing
End Sub

Extract Data from Sql and display to excel using vba

I am trying to join data from two sql tables. Table1 should have columns FileID, AccName, number,ut _score,uw_score
Table 2 should have columns FileID , label, data(contains y/N answers) and AdditionalComments. There are list of questions displayed under column Label. I need to look into last three questions(under the column LABEL) and post the result only if the answers are No
Both these tables can be identified with the unique file id, that is associated with every accountname. So I need to join the table that has only the columns as mentioned above.
Option Explicit
Sub GetDataFromADO()
'Declare variables'
Dim objMyConn As ADODB.Connection
Dim objMyCmd As ADODB.Command
Dim objMyRecordset As ADODB.Recordset
Dim iCols As Integer
Dim tbl As ListObject
Set objMyConn = New ADODB.Connection
Set objMyCmd = New ADODB.Command
Set objMyRecordset = New ADODB.Recordset
'Open Connection'
objMyConn.ConnectionString = "Provider=SQLOLEDB;Data Source= .;Initial Catalog=.;Trusted_connection=Yes;Integrated Security=SSPI;"
objMyConn.Open
'Dim sSqL As String
'Set objMyCmd.ActiveConnection = objMyConn
'sSqL = "Select FileID, AccName, number,ut _score,uw_score from AUT.dbo.LIST"
'objMyConn.Execute sSqL
'Set and Excecute SQL Command'
Dim u As String
Set objMyCmd.ActiveConnection = objMyConn
objMyCmd.CommandText = "select AccName, Underwriter, Auditor,UT_Score,Underwriter_Score from Actuarial.dbo.Audit_Checklist"
objMyCmd.CommandText = "Select Label, Data, AdditinalComments from Actuarial.dbo.List_data"
objMyCmd.CommandType = adCmdText
objMyCmd.Execute
'Open Recordset'
Set objMyRecordset.Source = objMyCmd
objMyRecordset.Open
For iCols = 0 To objMyRecordset.Fields.Count - 1
Worksheets("Data").Cells(1, iCols + 1).Value = objMyRecordset.Fields(iCols).name
Next
'Copy Data to Excel'
Worksheets("Data").Range("A2").CopyFromRecordset objMyRecordset
End Sub
Here is the sql query, that I need to include conditions to select last 6 values from the Label column of table 2. Kindly apologize for the naive where clause that i used. Appreciate any help on this !
SELECT Reports.dbo.tbl1.AccName,Reports.dbo.tbl1.Underwriter,
Reports.dbo.tbl1.Auditor, Reports.dbo.tbl1.UT_Score,
Reports.dbo.tbl1.Underwriter_Score, Reports.dbo.tbl2.Label,Reports.dbo.tbl2.Data, Reports.dbo.tbl2.AdditinalComments
FROM Reports.dbo.tbl1
INNER JOIN Reports.dbo.tbl2
ON Reports.dbo.tbl1.FileID=Reports.dbo.tbl2.FileID;
Where Reports.dbo.tbl2.Label='Is it profitable?' OR 'When is effective date expiring ? ' OR 'Did the community accept?';
**Output that I get now **
Expected Result

Loop through excel spreadsheet using macro

I'm trying to loop through excel cells to get value from sql server table. I've written a macro that will take the jobnumber from the excel and query sql server tale to get customer details and dump it on the spreadsheet. So far I'm only able to get data for single cell. How can I loop through the excel cells for more than one jobnumber. I'm new to VBA. Thanks for your help. Here is my macro:
Sub ConnectSqlServer()
Dim conn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim sConnString As String
Dim newrow As String
newrow = Worksheets("Sheet1").Cells(1, "A").Value
' Create the connection string.
sConnString = "Provider=SQLOLEDB;Data Source=0.0.0.0;" & _
"Initial Catalog=asset;" & _
"User ID=Temp;Password=test123;"
' 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("SELECT customer FROM job_tab where jobnum2='" & Trim(newrow) & "';")
' Check we have data.
If Not rs.EOF Then
' Transfer result.
Sheets(1).Range("B1").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
You can do so, by using the IN SQL statement:
SELECT customer FROM job_tab WHERE jobnum2 IN ( 'Value1', 'Value2', ... );
Therefore you have to loop through all the customers in column A of your table and alter the SQL request to use the above mentioned statement:
Sub ConnectSqlServer()
Dim conn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim sConnString As String
Dim newrow As String
'MODIFIED: create the search string for the IN-Statement
newrow = "("
For i = 1 To Worksheets("Sheet1").Cells(Worksheets("Sheet1").Rows.Count, "A").End(xlUp).Row
newrow = newrow & "'" & Trim(Worksheets("Sheet1").Cells(i, "A").value) & "',"
Next i
newrow = Left(newrow, Len(newrow) - 1)
newrow = newrow & ")"
' Create the connection string.
sConnString = "Provider=SQLOLEDB;Data Source=0.0.0.0;" & _
"Initial Catalog=asset;" & _
"User ID=Temp;Password=test123;"
' Create the Connection and Recordset objects.
Set conn = New ADODB.Connection
Set rs = New ADODB.Recordset
' Open the connection and execute.
conn.Open sConnString
'MODIFIED: altered the SQL statement to use the search string with IN
Set rs = conn.Execute("SELECT customer FROM job_tab where jobnum2 IN " & newrow & "';")
' Check we have data.
If Not rs.EOF Then
' Transfer result.
Sheets(1).Range("B1").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

"Application Defined or Object Defined" error in VBA-SQL connection

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

Resources