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
Related
I am creating an automate file to update the currency rates in the CurrencyTable (dB) on a button click. I have refer to the example as in this post.
My Excel data is as below:
CsName Rate
AUD 1.23
BHD 2.23
BND 3.23
EUR 4.23
IDR 5.23
INR 6.23
MYR 7.23
OMR 8.23
SGD 9.23
THB 10.23
USD 11.23
The code seems to work fine, however it does not updating as per the Excel data, instead, it only took the 4th row value for everything.
Here are the updated result.
Below are my codes:
Sub UpdateCR()
Dim con As New ADODB.Connection
Dim cmd As New ADODB.Command
Dim i As Long
Dim vDB As Variant
Dim Ws As Worksheet
con.ConnectionString = "Provider=SQLOLEDB.1;Password=1234;Persist Security Info=False;User ID=Guest;Initial Catalog=ABC;Data Source=XYZ"
con.Open
Set cmd.ActiveConnection = con
Set Ws = ActiveSheet
vDB = Ws.Range("a1").CurrentRegion
For i = 2 To UBound(vDB, 1)
cmd.CommandText = "UPDATE CurrencyTable SET Rate='" & vDB(i, 2) & "' WHERE CsName ='" & vDB(i, 1) & "' "
cmd.Execute
Next i
con.Close
MsgBox "Exchange rates successfully updated"
Set con = Nothing
End Sub
Does anyone know why is this happening? Is it related to the UBound function?
Any helps on this would be much appreciated!
Are all the CSNames correct in the table you're updating? Are they all set to EUR from something else, maybe coding this. May sound obvs, but just in case :)
First of all this is not the answer, I am posting here to explain the
troubleshooting as comments won't help.
What I am saying is print the string of what is being executed in another column.
For example:
Once you try this, can you please show the image from the 3rd column?
Sub UpdateCR()
Dim con As New ADODB.Connection
Dim cmd As New ADODB.Command
Dim i As Long
Dim vDB As Variant
Dim Ws As Worksheet
con.ConnectionString = "Provider=SQLOLEDB.1;Password=1234;Persist Security Info=False;User ID=Guest;Initial Catalog=ABC;Data Source=XYZ"
con.Open
Set cmd.ActiveConnection = con
Set Ws = ActiveSheet
vDB = Ws.Range("a1").CurrentRegion
For i = 2 To UBound(vDB, 1)
cmd.CommandText = "UPDATE CurrencyTable SET Rate='" & vDB(i, 2) & "' WHERE CsName ='" & vDB(i, 1) & "' "
cmd.Execute
Cells(i, 3) = "UPDATE CurrencyTable SET Rate='" & vDB(i, 2) & "' WHERE CsName ='" & vDB(i, 1) & "' "
Next i
con.Close
MsgBox "Exchange rates successfully updated"
Set con = Nothing
End Sub
For me the result looks like below, is it same for you?
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
I am new to VBA and Excel Scripting, however, I am trying to use it to connect to an SQL Server I have created. I have built a generalized query from a userform, and created a successful SELECT statements that fill my sheet.
However, when I try to update this information in the database I am unsuccessful. The code throws no errors, but I cannot find my changes in the database. Here is my attempt:
Private Sub dbUpdate(Query)
Dim conn As ADODB.Connection
Dim recset As ADODB.Recordset
Dim cmd As ADODB.Command
Dim strConn As String
'Create the connection string
strConn = "Provider=SQLNCLI11;Server=IP-Address;Database=Info;Trusted_Connection=yes;DataTypeCompatibility=80;"
'Create the connection and recordset objects
Set conn = New ADODB.Connection
Set recset = New ADODB.Recordset
'Open the connection
conn.Open strConn
'Open the recordset with the query
'Previous attempt, no errors
'recset.Open Query, conn
'Execute the recordset
Set cmd = New ADODB.Command
'The below execution of a query throws errors I believe
cmd.CommandText = Query
Set recset = cmd.Execute
'Close things up
Set recset = Nothing
'recset.Close
conn.Close
Set conn = Nothing
End Sub
I am pretty sure the query is correct, but I will update tomorrow if I still can't figure it out.
Here is one example that could work for you.
Sub ImportDataFromExcel()
Dim rng As Range
Dim r As Long
Dim conn As ADODB.Connection
Dim strConn As String
Dim strSQL As String
strConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & _
"C:\Users\Ryan\Desktop\Coding\Integrating Access and Excel and SQL Server\Access & Excel & SQL Server\" & _
"EXCEL AND ACCESS AND SQL SERVER\Excel & Access\Select, Insert, Update & Delete\Northwind.mdb"
Set conn = New ADODB.Connection
conn.Open strConn
With Worksheets("Sheet1")
lastrow = .Range("A2").End(xlDown).Row
lastcolumn = .Range("A2").End(xlToRight).Column
Set rng = .Range(.Cells(lastrow, 1), .Cells(lastrow, lastcolumn))
End With
'therow = 1
For i = 2 To lastrow
'r = rng.Row
'If r > 1 Then
strSQL = "UPDATE PersonInformation SET " & _
"FName='" & Worksheets("Sheet1").Range("B" & i).Value & "', " & _
"LName='" & Worksheets("Sheet1").Range("C" & i).Value & "', " & _
"Address='" & Worksheets("Sheet1").Range("D" & i).Value & "', " & _
"Age=" & Worksheets("Sheet1").Range("E" & i).Value & " WHERE " & _
"ID=" & Worksheets("Sheet1").Range("A" & i).Value
conn.Execute strSQL
'End If
'r = r + 1
Next i
conn.Close
Set conn = Nothing
End Sub
There are so, so, so many different versions of this. Hopefully you can adapt this example to fit your specific needs.
I am novice in VBA so please don't mind if the question is of low level.I am trying to run a SQL query where the data has to be extracted from one of the sheets of the same workbook.
SQL = "Select ProductNumber from [sData$] where ProductSource = " & pSource & "
'pSource is a string that stores Product Source
'sdata is a sheet named as Data in the workbook
dataPath = ThisWorkbook.Fullname
'Not sure if this is the value I shall send as datapath in getData function
Set rst = getData(dataPath,SQL)
rst.Open
The getData function is defines as below
Public funtion getData(path as String, SQL as string) as ADODB.Recordset
Dim rs as ADODB.Recordset
Set cn = New ADODB.Connection
Set rs = New ADODB.Recordset
cn.Open ("Provider= Microsoft.Jet.OLEDB.4.0;" & _
"DataSource= " & path & ";"&_
"Extended Properties=""Excel 8.0;HDR=Yes;FMT=Delimited;IMEX=1;""")
rs.ActiveConnection =cn
rs.Source= SQL
Set getData =rs
End Function
Now after I get the numbers from Data sheet, I need to find the corresponding
ProductCompany from Relation sheet. 9 is for Amul, 5 is for Nestle and so on.
Relation:
I am not sure how to do that. The numbers corresponds to their respective Product company in order.
Take a look at the below example showing how to create ADODB connection to this workbook, get ADODB recordset from SQL query, retrieve key - value pairs from relation sheet, create and populate a dictionary, and output the values from the recordset and the corresponding values from the dictionary:
Option Explicit
Sub Test()
Dim oCn As Object
Dim oRs As Object
Dim aKeys
Dim aItems
Dim i As Long
Dim oDict As Object
Dim dProdNum
' create ADODB connection to this workbook
Set oCn = CreateObject("ADODB.Connection")
oCn.Open _
"Provider=Microsoft.Jet.OLEDB.4.0;" & _
"DataSource='" & ThisWorkbook.FullName & "';" & _
"Extended Properties=""Excel 8.0;HDR=Yes;FMT=Delimited;IMEX=1;"";"
' get ADODB recordset from SQL query
Set oRs = oCn.Execute("SELECT DISTINCT ProductNumber FROM [Data$] WHERE ProductSource = 'A1'")
' retrieve key - value pairs from relation sheet
With ThisWorkbook.Sheets("Relation")
aKeys = Split(.Range("B1"), ",")
aItems = Split(.Range("B2"), ",")
End With
' create and populate a dictionary
Set oDict = CreateObject("Scripting.Dictionary")
For i = 0 To UBound(aKeys)
oDict(Trim(aKeys(i)) + 0) = Trim(aItems(i))
Next
' output the values from the recordset and the corresponding values from the dictionary
oRs.MoveFirst
Do Until oRs.EOF
dProdNum = oRs.Fields(0).Value
Debug.Print dProdNum & " - " & oDict(dProdNum)
oRs.MoveNext
Loop
End Sub
The output for me is as follows:
4 - Britanica5 - Nestle9 - Amul
Note, connection string in the above code shown for .xls file. In case .xlsm you should use:
oCn.Open _
"Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source='" & ThisWorkbook.FullName & "';" & _
"Extended Properties=""Excel 12.0 Macro;HDR=Yes;FMT=Delimited;IMEX=1;"";"
I'm using a Excel macro to transfer data between works with ADO by following these guidelines. Currently, I've set up the code to search for a keyword in column A of the source file. Once it finds the keyword, it will copy data from that entire row. However, I only need data from columns G-I, and cannot find the information to condense the data selection.
Public Sub MoveData()
'defines the project name as a variable
Dim fileName As String
fileName = Worksheets("Cover").Range("B5").Value
'defines the path
Dim path As String
path = "C:\Users\(user)\Documents\(folder)\" & fileName & ".csv"
'defines the two workbooks that the data will move between
Dim currentWB As Workbook
Set currentWB = ThisWorkbook
Dim openWB As Workbook
Set openWB = Workbooks.Open(path)
Dim openWs As Worksheet
Set openWs = openWB.Sheets(fileName)
'connects using ADODB to transfer the data
Dim cn As ADODB.Connection
Set cn = New ADODB.Connection
With cn
.Provider = "Microsoft.ACE.OLEDB.12.0"
.ConnectionString = "Data Source=" & path & ";" & _
"Extended Properties=Excel 12.0 Xml;"
.Open
End With
'selects the first column to be read and sorted
Dim subCell As Range
Dim myRange As Range
Set myRange = Range("A1:A500")
Dim cmdOpen As Boolean
cmdOpen = False
For Each subCell In myRange
'searches for the column markups
If subCell Like "*COLUMN*" Then
strQuery = "SELECT * FROM [" & fileName & "$] Where Subject = '" & subCell.Value & "'"
Set cmd = New ADODB.Command
With cmd
.ActiveConnection = cn
.CommandText = strQuery
End With
Dim rst As New ADODB.Recordset
With rst
If cmdOpen = False Then
.Open cmd
cmdOpen = True
End If
End With
currentWB.Worksheets("Cols").Range("B7:D7").CopyFromRecordset rst
End If
Next subCell
openWB.Close
End Sub
This strQuery = "SELECT * FROM [" & fileName & "$] Where Subject = '" & subCell.Value & "'" is the line I am referring to. It selects the row of data where the keyword is found. I want to limit this selection to columns G-I. Any advice on how I could accomplish this would be greatly appreciated.