Push Excel Range to SQL Table via VBA - sql

I am in need of pushing a range in Excel to a new row in an SQL table each time an associate executes a VBA macro. So far, I have segregated the data into a single row and multiple columns (110 cells of data in total) in Excel. My problem right now is stemming from how to insert each one of these individual cells from the Excel sheet into the corresponding column and the first empty row in an SQL table. I've done some pretty extensive searches of the internet and have found nothing remotely close to what I am trying to do.
Is there a correct procedure that would allow me to dump a 110-column row into the first empty row in an SQL table?
I have the tables written and I have the range set:
Set DataBaseData = ActiveSheet.Range("DO1:HT1")
Beyond this I have no idea in which manner to open a connection with the Server, Database and Table. This is what I've winged so far:
Sub Connection()
Dim Conn As ADODB.Connection
Dim Command As ADODB.Command
Set Conn = New ADODB.Connection
Set Command = New ADODB.Command
Dim i As Integer
Dim columnnumber As Integer
i = 0
Conn.ConnectionString = "Provider=SQLOLEDB; Data Source=[Nope];Initial Catalog=[NopeNope];User ID=[NopeNopeNope];Password=[AbsolutelyNot]; Trusted_Connection=no;"
Conn.Open
Command.ActiveConnection = Conn
End Sub
Any help would be greatly appreciated.
If you have the curiosity as to what I'm trying to do: I'm pushing a series of data from a CMM to the Database so I can store the data for the needed amount of time, and call that data back to PowerBI and Minitab.

I was able to successfully write an entire row from Excel to an SQL Database using the following:
Sub Connection()
Const Tbl As String = "NEIN"
Dim InsertQuery As String, xlRow As Long, xlCol As Integer
Dim DBconnection As Object
Set DBconnection = CreateObject("ADODB.Connection")
DBconnection.Open "Provider=SQLOLEDB.1;Password=NEIN" & _
";Persist Security Info=false;User ID=NEIN" & _
";Initial Catalog=NEIN;Data Source=NEIN"
InsertQuery = ""
xlRow = 1 'only one row being used *as of now*, and that is the top row in the excel sheet
xlCol = 119 'First column of data
While Cells(xlRow, xlCol) <> ""
InsertQuery = InsertQuery & "INSERT INTO " & Tbl & " VALUES('"
For xlCol = 119 To 229 'columns DO1 to HT1
InsertQuery = InsertQuery & Replace(Cells(xlRow, xlCol), "'", "''") & "', '" 'Includes mitigation for apostrophes in the data
Next xlCol
InsertQuery = InsertQuery & Format(Now(), "M/D/YYYY") & "')" & vbCrLf 'The last column is a date stamp, either way, don't forget to close that parenthesis
Wend
DBconnection.Execute InsertQuery
DBconnection.Close
Set DBconnection = Nothing
End Sub

Related

Update SQL from Excel sheet using VBA

I am trying to update some records in SQL from excel sheet using VBA. I have a lot of records in the excel sheet so this is why I want to automate this. Below is a sample of the field I want to update "rmn_dr". "t_id" is unique in both tables. I want to update "rmn_dr" in the SQL "Job" table with values from "Excel Sheet"
Excel Sheet
t_id rmn_dr
310449 16
310450 120
310451 256
310452 165.2
JOB (SQL Table)
t_id rmn_dr
310449 2
310450 5
310451 7
310452 0
Can someone help me with the VBA code please? Thanks
If each field is text, try the following.
The assumption is that the data on the Excel sheet is listed from a1 Cell, including fields.
Sub setDAtaToServer()
Dim con As New ADODB.Connection
Dim cmd As New ADODB.Command
Dim rst As New ADODB.Recordset
Dim i As Long
Dim vDB As Variant
Dim Ws As Worksheet
con.ConnectionString = "Provider=SQLOLEDB.1;" _
& "Server=(local);" _
& "Database=JOB;" _
& "Integrated Security=SSPI;" _
& "DataTypeCompatibility=80;"
con.Open
Set cmd.ActiveConnection = con
Set Ws = ActiveSheet
vDB = Ws.Range("a1").CurrentRegion
For i = 2 To UBound(vDB, 1)
cmd.CommandText = "UPDATE JOB SET rmn_dr='" & vDB(i, 2) & "' WHERE t_id='" & vDB(i, 1) & "' "
cmd.Execute
Next i
con.Close
Set con = Nothing
End Sub

How to export Excel data from different sheets to SQL-SERVER Database?

I am new in Excel VBA and SQL. I have managed to create a macro button and push Excel cell data to SQL server tables. However, I am a bit puzzled:
How can I take Excel cell data from different sheets and then push them to different tables in SQL Server database? (Currently, I have 3 sheets - Customers, Test, Information - in one Excel file.)
Current working code:
Sub Button1_Click()
Dim conn As New ADODB.Connection
Dim iRowNo As Integer
Dim sCustomerId, sFirstName, sLastName As String
With Sheets("Customers")
'Open a connection to SQL Server
conn.Open "Provider=SQLOLEDB;Data Source=TESTpc\SQLEXPRESS;Initial Catalog=ExcelSQLServerDemo;Trusted_connection=yes"
'Skip the header row
iRowNo = 2
'Loop until empty cell in CustomerId
Do Until .Cells(iRowNo, 1) = ""
sCustomerId = .Cells(iRowNo, 1)
sFirstName = .Cells(iRowNo, 2)
sLastName = .Cells(iRowNo, 3)
'Generate and execute sql statement to import the excel rows to SQL Server table
conn.Execute "INSERT into dbo.Customers (CustomerId, FirstName, LastName) values ('" & sCustomerId & "', '" & sFirstName & "', '" & sLastName & "')"
iRowNo = iRowNo + 1
Loop
MsgBox "Customers Exported To Database"
conn.Close
Set conn = Nothing
End With
End Sub
Do I need to store the data in arrays and then push them to the database?
You shouldn't use insert queries for every row you want to export. Instead, if you want to do it manually, open a recordset:
Sub Button1_Click()
Dim conn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim iRowNo As Integer
Dim sCustomerId, sFirstName, sLastName As String
With Sheets("Customers")
'Open a connection to SQL Server
conn.Open "Provider=SQLOLEDB;Data Source=TESTpc\SQLEXPRESS;Initial Catalog=ExcelSQLServerDemo;Trusted_connection=yes"
conn.CursorLocation = adUseClient 'Use a client-side cursor
rs.Open "SELECT * FROM dbo.Customers", conn, adOpenDynamic, adLockOptimistic 'Open the table into a recordset
'Skip the header row
iRowNo = 2
'Loop until empty cell in CustomerId
Do Until .Cells(iRowNo, 1) = ""
rs.AddNew 'Add a new row
rs!CustomerId = .Cells(iRowNo, 1) 'Set row values
rs!FirstName = .Cells(iRowNo, 2)
rs!LastName = .Cells(iRowNo, 3)
rs.Update 'Commit changes to database, you can try running this once, or once every X rows
iRowNo = iRowNo + 1
Loop
MsgBox "Customers Exported To Database"
conn.Close
Set conn = Nothing
End With
End Sub
This has several advantages, including but not limited to increased performance, the ability to insert quoted values and increased stability.
Use Sql Server Import and Export Data 64 Bit or 32 Bit
STEP 1 :
STEP 2:
STEP 3:
STEP 4:
Step 5 :
Follow the next steps

VBA Update sql from Excel to MS SQL Server 2008 using ListColumns

I am working on an Excel 2010 Workboox where a macro pulls in data from a database table. The users can then update the values of Column06) to a specific value if needed. Once complete, they can run a macro to run a SQL update so Column06 in the database is updated where COLUMN01 and COLUMN02 are in the database table. I know the ADO connection is working as I tried with a very generic sql which worked fine. I know that the table could be of varying lengths, so I knew I probably needed to loop through the rows, and that's where I'm stuck.
I tried setting up a loop similar to another solution I found online, and started getting Run-Time Error 91 "Object variable or with block variable not set". I think is due to the ListObject.ListColumns I'm using in the new Update Statement. I've tried using other examples to declare these, but it usually ends up in other errors. I must be missing something, or doing something wrong. Any help would be greatly appreciated.
Sub Updatetbl_data()
'
' Updatetbl_data Macro
' test
Sheets("Sheet2").Select
Dim cnn As ADODB.Connection
Dim uSQL As String
Set cnn = New Connection
cnnstr = "Provider=SQLOLEDB; " & _
"Data Source=MySource; " & _
"Initial Catalog=MyDB;" & _
"User ID=ID;" & _
"Password=Pass;" & _
"Trusted_Connection=No"
cnn.Open cnnstr
' New Update Statement idea based on possible solution found online
Dim row As Range
For Each row In [tbl_data].Rows
uSQL = "UPDATE tbl_data SET Column06 = '" & (row.Columns (row.ListObject.ListColumns("Column06").Index).Value) & _
"' WHERE Column01 = '" & (row.Columns(row.ListObject.ListColumns ("Column01").Index).Value) & _
"' AND Column02 = '" & (row.Columns(row.ListObject.ListColumns("Column02").Index).Value) & "' "
'Debug.Print (uSQL)
cnn.Execute uSQL
Next
cnn.Close
Set cnn = Nothing
Exit Sub
'
End Sub
Perhaps row.Columns is not designed for what you want to achieve. You can give this link to another article on stackoverflow a look for some more information. Next, I made some changes to your code which might do the trick.
' ... ... ...
Dim row As Range
'For Each row In [tbl_data].Rows ==>> has to be replaced by
'For Each row In [tbl_data] ==>> which returns all cells, perhaps better the following
Const ColNbr_Column01 As Long = 1
Const ColNbr_Column02 As Long = 2
Const ColNbr_Column06 As Long = 6
' now, select only the first column of the range [tbl_data]
For Each row In Range( _
[tbl_data].Cells(1, 1).Address, _
[tbl_data].Cells([tbl_data].Rows.Count, 1).Address)
' now, use offset to reach to the columns in the row
uSQL = "UPDATE tbl_data SET Column06 = '" & row.Offset(0, ColNbr_Column06).Value & _
"' WHERE Column01 = '" & row.Offset(0, ColNbr_Column01).Value & _
"' AND Column02 = '" & row.Offset(0, ColNbr_Column02).Value & "' "
'Debug.Print (uSQL)
' ... ... ...
This is the basic concept.
Sub InsertInto()
'Declare some variables
Dim cnn As adodb.Connection
Dim cmd As adodb.Command
Dim strSQL As String
'Create a new Connection object
Set cnn = New adodb.Connection
'Set the connection string
cnn.ConnectionString = "Provider=SQLOLEDB.1;Integrated Security=SSPI;Persist Security Info=True;Initial Catalog=Database;Data Source=Server_Name"
'Create a new Command object
Set cmd = New adodb.Command
'Open the Connection to the database
cnn.Open
'Associate the command with the connection
cmd.ActiveConnection = cnn
'Tell the Command we are giving it a bit of SQL to run, not a stored procedure
cmd.CommandType = adCmdText
'Create the SQL
strSQL = "UPDATE TBL SET JOIN_DT = '2017-10-08' WHERE EMPID = 1"
'Pass the SQL to the Command object
cmd.CommandText = strSQL
'Execute the bit of SQL to update the database
cmd.Execute
'Close the connection again
cnn.Close
'Remove the objects
Set cmd = Nothing
Set cnn = Nothing
End Sub

Extracting data from over a million records

I have an Excel file in which I have set up a connection with an Access database. In the Excel file I have a list of names in column A, and I want to search these names in the Access database and return back two fields from that database. I need to do this for around 200-300 names.
Here is my code:
N = Cells(Rows.Count, "A").End(xlUp).Row
Application.DisplayAlerts = False
strDB = ThisWorkbook.Path & "file.accdb"
Set objConnection = New ADODB.Connection
objConnection.Open "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & strDB
For i = 2 To N
Dim rstTable As ADODB.Recordset
Set rstTable = New ADODB.Recordset
lookup = Range("A" & i).Value
strSQL = "SELECT NAME1,NAME2 FROM DATA WHERE [Field2]= """ & lookup & """;"
'Store query output
rstTable.Open Source:=strSQL, ActiveConnection:=objConnection
'Paste results to Transactions sheet
Worksheets("Sheet1").Range("B" & i).CopyFromRecordset rstTable
'Close the record set & connection
rstTable.Close
objConnection.Close
Next i
This works (kindof) but it takes an extremely long time and randomly crashes. Any ideas how to improve this?
Making sure there is a key on the lookup field will help. I would suggest making a copy of the workbook and test external data from Access or MS Query to see if that gives a performance gain over VBA.
When using MS Query or data from Access, you can modify the command text in the connection properties and use ? in the where clause to specify the parameter in the worksheet (so you don't lose that functionality).
I modified your SQL statement. Replace the Where [Field2] = "xxx" by Where [Field2] IN ("xxx", "yyy", "zzz").
N = Cells(Rows.Count, "A").End(xlUp).Row
Application.DisplayAlerts = False
strDB = ThisWorkbook.Path & "file.accdb"
Set objConnection = New ADODB.Connection
objConnection.Open "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & strDB
For i = 2 To N
lookup = lookup & "'" & Range("A" & i).Value & "', "
Next i
lookup = left(lookup, len(lookup) - 2)
Dim rstTable As ADODB.Recordset
Set rstTable = New ADODB.Recordset
strSQL = "SELECT NAME1,NAME2 FROM DATA WHERE [Field2] IN (" & lookup & ");"
'Store query output
rstTable.Open Source:=strSQL, ActiveConnection:=objConnection
'Paste results to Transactions sheet
Worksheets("Sheet1").Range("B" & i).CopyFromRecordset rstTable
'Close the record set & connection
rstTable.Close
objConnection.Close
You close the connection after the first iteration, so your next iteration -- which does not have code to open the connection -- would fail. So you should move the objConnection.Close out of the loop.
But, even then, to execute the same kind of query over and over again, just with a different argument, can be done in one go, using the IN (...) syntax:
' Declare all your variables
Dim N As Long
Dim strDB As String
Dim objConnection As ADODB.Connection
Dim rstTable As ADODB.Recordset
Dim strSQL As String
N = Cells(Rows.Count, "A").End(xlUp).Row
Application.DisplayAlerts = False
strDB = ThisWorkbook.Path & "file.accdb"
Set objConnection = New ADODB.Connection
objConnection.Open "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & strDB
' collect the values in comma-separated string
lookup = ""
For i = 2 To N
lookup = lookup & ",""" & Range("A" & i).Value & """"
Next i
' Chop off the first comma
lookup = Mid(lookup, 2)
' Perform a single query, but also select the Field2 value
Set rstTable = New ADODB.Recordset
strSQL = "SELECT Field2, NAME1,NAME2 FROM DATA WHERE [Field2] IN (" & lookup & ");"
' query output
rstTable.Open Source:=strSQL, ActiveConnection:=objConnection
' Retrieve values
While Not rstTable.EOF
lookup = rstTable.Fields(0).Value
' Locate in which row to put the result
For i = 2 To N
If lookup = Range("A" & i).Value Then
Range("B" & i).Value = rstTable.Fields(1).Value
Range("C" & i).Value = rstTable.Fields(2).Value
End If
Next i
rstTable.MoveNext
Loop
' Close the record set & connection
rstTable.Close
objConnection.Close
You can do what you described, but I think it's far more efficient to do this in Access itself. Just create a table with your names and do an Inner Join to the table you want to find 2 fields. Should take less than a minute, and probably less than 30 seconds.

VBA Excel - Saving column names to spreadsheet from MS Access

I am using VBA in Visual Studio Express. What I am trying to do is give the top row of my excel spreedsheet that i have created by exporting an MS Access DB through VB, column names, i.e. the names that i have in my DB.
There are 10 columns the 9th is skipped, i have also spaced the spreedsheet out to allow for the first row to have headers, how would i fill the first row of my spreedsheet with the column names of my DB?
Also it is fine if to assign the names directly through the code rather than passing the column headers from the DB as well.
My Code:
Public Sub ExportEx()
Dim strSQL_Query As String
Dim oCN As ADODB.Connection
Dim oCMD As ADODB.Command
Dim oRecords As ADODB.Recordset
Dim strDBPath As String
Dim varValues As Object
Dim lngRows As Long
Dim lngCols As Long
Dim strCN As String
strDBPath = Application.StartupPath & "\SCO_Leaderboard.accdb"
strCN = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strDBPath & ";" & _
"Persist Security Info=False;"
strSQL_Query = "Select top 10 Rank, Username, Time_Played, Lv, EXP, Floor, Col, Logins, Status FROM tblUsers ORDER BY Rank ASC"
Dim oExcel As Object
Dim oBook As Object
Dim oSheet As Object
oExcel = CreateObject("Excel.Application")
oBook = oExcel.Workbooks.Add
oSheet = oBook.Worksheets(1)
oCN = New ADODB.Connection
oCN.ConnectionString = strCN
oCN.Open()
oCMD = New ADODB.Command
oCMD.ActiveConnection = oCN
oCMD.CommandText = strSQL_Query
oRecords = oCMD.Execute
varValues = oRecords.GetRows
lngCols = UBound(varValues, 2)
lngRows = UBound(varValues, 1)
oSheet.Range("A2", oSheet.Range("A2").Offset(lngRows, lngCols)) = varValues
oBook.SaveAs(Application.StartupPath & "\Top_10_All_Time.xls")
oExcel.Quit()
MsgBox("An Excel spreadsheet has been created under:" & vbNewLine & vbNewLine & Application.StartupPath & "\Top_10_All_Time.xls")
'' Clean up...
oCMD = Nothing
oCN.Close()
oCN = Nothing
On another note how would I space the fields out in Excel so that all the data fit in the column?
Thanks for any help,
Andy
In VBA, there are two methods to exporting Access table/query data to an Excel spreadsheet:
1) TransferSpreadsheet method
This command will export all fields and records. So, save your VBA string as a stored query object and reference it in below command:
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, _
"yourtableorqueryname", "fullpathtoExcelFile", True
2) CopyFromRecordset method
This command will export only records. However, you can use the recordset's Fields property to fill in first row. Do note the code below assumes you create an ADO recordset named rst using your ADODB connection.
Dim rst As ADODB.Recordset
Set rst = New ADODB.Recordset
rst = "Select top 10 Rank, Username, Time_Played, Lv, EXP, Floor, Col, Logins, Status" _
& " FROM tblUsers ORDER BY Rank ASC", oCN
oSheet.Range("A1").Select
For Each fld In rst.Fields
oExcel.ActiveCell = fld.Name
oExcel.ActiveCell.Offset(0, 1).Select
Next
'REMOVE BELOW IF YOU WANT ONLY COLUMN HEADERS NOT DATA
oSheet.Range("A2").CopyFromRecordset rst
'TO AUTO FIT (SPACE OUT) COLUMNS
osheet.Range("A1:I" & rst.RecordCount + 1).Columns.AutoFit
This works in Access, I am not sure if it works in your case:
Select top 10 Rank As Header1, Username As Header2, Time_Played As Header3 ...
You would have to retrieve the fields Collection from the scheam of oRecords:
oRecords = oCMD.Execute
or just parse the field names from strSQL ...
or - very easy, as you define the field names and build your SQL from the field names - put these in an array and then build the first row of your range from this array.