VBA Excel ADO SQL Update Query Not Working - sql

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.

Related

VBA & SQL how to select specific values based on range in excel?

I am newbie in connection of vba (excel) and oracle database. I have tried to look for some information but I could not find anything that would work for me.
I want to write a query that will return me only rows in which there is a specific values.
My query looks like this:
SQLStr = SQLStr = "SELECT NGKHFHCD, NGKHFNAM, NGKHGNKA, NGKHSZIC, NGKHMTRC, NGKHSNZC, NGKHGCHC, NGKHKKKS, NGKHKTKS FROM NGKH order by NGKHFHCD"
But I want to have something that will be like this SQLStr = "SELECT NGKHFHCD, NGKHFNAM, NGKHGNKA, NGKHSZIC, NGKHMTRC, NGKHSNZC, NGKHGCHC, NGKHKKKS, NGKHKTKS FROM NGKH WHERE NGKHFHCD = SHeet1(A2:A)"
I just don't want to pull out whole table from oracle, because it will take a lots of time so I thought that maybe I can return only specific rows from that table.
Also if there is no searched value in the table I would like to mark it in someway.
Is there anyway to solve it?
my code:
Sub OracleLocalConnect()
Dim RecordSet As New ADODB.RecordSet
Dim con As New ADODB.Connection
Dim ExcelRange As Range
Dim SQLStr As String
Dim ws As Worksheet
con.ConnectionString = "Provider=OraOLEDB.Oracle.1;User ID=***;Password=****;Data Source=*****;"
con.Open
Set RecordSet = CreateObject("ADODB.Recordset")
SQLStr = "SELECT GNKHFHCD, GNKHFNAM, GNKHGNKA, GNKHSZIC, GNKHMTRC, GNKHSNZC, GNKHGCHC, GNKHKKKS, GNKHKTKS FROM GNKH ORDER BY GNKHFHCD"
RecordSet.Open SQLStr, con, adOpenStatic, adLockReadOnly
Set ws = ActiveWorkbook.Sheets("Prices")
Set ExcelRange = ws.Range("A2")
ExcelRange.CopyFromRecordset RecordSet
RecordSet.Close
con.Close
Exit Sub
Exit Sub
End Sub
Untested but this would be close:
Sub OracleLocalConnect()
Dim RecordSet As New ADODB.RecordSet
Dim con As New ADODB.Connection
Dim ExcelRange As Range
Dim SQLStr As String
Dim ws As Worksheet
con.ConnectionString = "Provider=OraOLEDB.Oracle.1;User ID=***;Password=****;Data Source=*****;"
con.Open
Set RecordSet = CreateObject("ADODB.Recordset")
SQLStr = " SELECT GNKHFHCD, GNKHFNAM, GNKHGNKA, GNKHSZIC, GNKHMTRC, " & _
" GNKHSNZC, GNKHGCHC, GNKHKKKS, GNKHKTKS FROM GNKH " & _
" where " & InClause(Sheet1.Range("A2:A1000"), "GNKHFHCD", True) & _
" ORDER BY GNKHFHCD "
RecordSet.Open SQLStr, con, adOpenStatic, adLockReadOnly
Set ws = ActiveWorkbook.Sheets("Prices")
Set ExcelRange = ws.Range("A2")
ExcelRange.CopyFromRecordset RecordSet
RecordSet.Close
con.Close
End Sub
'Create an in clause for an Oracle query
Function InClause(rng As Range, colName As String, Optional quoted As Boolean = False)
'https://stackoverflow.com/questions/400255/how-to-put-more-than-1000-values-into-an-oracle-in-clause
Dim s As String, c As Range, qt As String, sep As String
qt = IIf(quoted, "'", "")
sep = ""
s = "(999, " & colName & ") in ("
For Each c In rng.Cells
If Len(c.Value) > 0 Then
s = s & sep & vbLf & "(999," & qt & c.Value & qt & ")"
sep = "," 'add comma after first pass
End If
Next c
InClause = s & ")"
End Function

Complications with moving data from SQL Server to Excel using VBA

I am trying to extract data from SQL Server into Excel to populate a pre-existing worksheet so I wrote a test code to this this out. While it is imperfect what I was mainly testing was establishing the connection to the server but I run into an Automation error Error 440 when I open the connection. What am I doing wrong within that portion of code.
I haven't made any modifications as of yet and have check to make sure it compiled just fine.
Sub GetPhysicalCount()
Dim squery As String
Dim cnLogs As New ADODB.Connection
Dim rsData As New ADODB.Recordset
Dim rsHeaders As New ADODB.Recordset
Dim x As Long
Dim y As Long
Dim dbpath As String
Dim dbname As String
Dim AppExcel As Excel.Application
Dim Workbook As Object
Dim Worksheet As Object
Dim strConn As String
Dim Count As Long
pUser = "AllenBroady"
pPsw = "Cthulu90"
pServer = "IMCPU_TEST"
pCatalog = "MasterMFG"
strConn = "Provider = SQLOLEDB;"
strConn = strConn & "Initial Catalog= & pCatalog; & Data Source= & pServer;"
strConn = strConn & "Integrated Security=sspi;& User ID= & pUser; & Password= & pPsw;"
cnLogs.Open strConn
With rsHeaders
.ActiveConnection = cnLogs
.Open "SELECT * FROM MasterMFG WHERE Dept_Code = 001"
Do While Not rsHeaders.EOF
Cells(1, l_counter + 1) = rsHeaders(0)
l_counter = l_counter + 1
rsHeaders.MoveNext
Loop
.Close
End With
With rsCount
.ActiveConnection = cnLogs
.Open "SELECT COUNT(Dept_Code)FROM MasterMFG WHERE Total <> 0"
Count = rsCount
.Close
End With
With rsData
.ActiveConnection = cnLogs
.Open "SELECT Dept_Code, Total FROM MasterMFG WHERE Total <> 0"
For i = 1 To Count
Sheet1.Range("A" & i + 1) = rsData.Fields(i)
rsData.MoveNext
Sheet1.Range("B" & i + 1) = rsData.Fields(i)
Next i
.Close
End With
cnLogs.Close
Set cnLogs = Nothing
Set rsHeaders = Nothing
Set rsData = Nothing
Sheets(1).UsedRange.EntireColumn.AutoFit
End Sub
I keep getting an "Automation" error (Error 440)
Your strConn = strConn strings are not concatenated properly.
Your variables aren't evaluating, their names are just being put straight into the string.
Change, e.g.
strConn = strConn & "Initial Catalog= & pCatalog; & Data Source= & pServer;"
strConn = strConn & "Integrated Security=sspi;& UserID= & pUser; & Password= & pPsw;"
to
strConn = strConn & "Initial Catalog=" & pCatalog & ";Data Source=" & pServer & ";"
strConn = strConn & "Integrated Security=sspi;User ID= "& pUser; & "Password= " & pPsw & ";"

Update SQL Server table from Excel VBA

I'm trying to use the below code to take the active cell and update a table in SQL Server.
Sub UpdateTable()
Dim rngName As Range
cnnstr = "Provider=SQLOLEDB; " & _
"Data Source=MyServer; " & _
"Initial Catalog=Mydb;" & _
"User ID=User;" & _
"Password=Pwd;" & _
"Trusted_Connection=No"
Set rngName = ActiveCell
'Debug.Print (rngName)
Set cnn = New ADODB.Connection
Application.ScreenUpdating = False
cnn.Open cnnstr
Set rs = New ADODB.Recordset
uSQL = "UPDATE MyTable SET FieldNameX = 1 WHERE FieldNameY = '" & rngName & "' "
rs.CursorLocation = adUseClient
rs.Open uSQL, cnn, adOpenStatic, adLockOptimistic, adCmdText
rs.Close
Set rs = Nothing
cnn.Close
Set cnn = Nothing
Exit Sub
End Sub
When stepping through the code, it run time errors on the line rs.close, says Operation is not allowed when the object is closed I've set and opened the record set in the code so why would it be closed?
What would I need to do to correct the issue and let the active cell populate the query and update the table in SQL Server?
This below is the code I used to be able to update the table in SQL Server, this works just how I wanted. It takes the activecell and updates.
Sub UpdateTable()
Dim cnn As ADODB.Connection
Dim uSQL As String
Dim rngName As Range
Set cnn = New Connection
cnnstr = "Provider=SQLOLEDB; " & _
"Data Source=MyServer; " & _
"Initial Catalog=Mydb;" & _
"User ID=User;" & _
"Password=Pwd;" & _
"Trusted_Connection=No"
Set rngName = ActiveCell
cnn.Open cnnstr
uSQL = "UPDATE MyTable SET FieldNameX = 1 WHERE FieldNameY= '" & rngName & "' "
'Debug.Print (uSQL)
cnn.Execute uSQL
cnn.Close
Set cnn = Nothing
Exit Sub
End Sub

Operation must use an Updateable Query / SQL - VBA

I am trying to create a very dynamic macro that will update different tables in a Database, depending on what the user chooses. Each table has of course distinct titles and information. I'm having a problem with the update (when the user adds new records to an old Table). This is part of the code, the problem is when it gets to the ".update", I get the "Operation must use an Updateable Query" error.
Dim DBCnn As ADODB.Connection
Dim RecSet As ADODB.Recordset
Dim sQRY As String
Dim FilePath, Titulo, Tabla As String
Dim LastRow, LastColumn, TotalRecords, Id As Long
Set DBCnn = New ADODB.Connection
Set RecSet = New ADODB.Recordset
DBCnn.Mode = adModeReadWrite
DBCnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & FilePath & ";"
sQRY = "SELECT * FROM Customers" & Tabla ' & " WHERE PopID = " & lngid
RecSet.CursorLocation = adUseClient
RecSet.Open _
Source:=sQRY, _
ActiveConnection:=DBCnn, _
CursorType:=adOpenDynaset, _
LockType:=adLockOptimistic
Do While Range("A" & LastRow).Value <> ""
' repeat until first empty cell in column A
With RecSet
.AddNew
.Fields("Id") = Range("A" & LastRow).Value
.Fields("Name") = Range("B" & LastRow).Text
.Fields("Age") = Range("C" & LastRow).Value
.Update '(Here's my error)
End With
LastRow = LastRow + 1
Loop
Discard this line:
RecSet.CursorLocation = adUseClient
Or try it like this instead:
RecSet.CursorLocation = adUseServer
See the Remarks section at CursorLocation Property (ADO) on MSDN:
"If the CursorLocation property is set to adUseClient, the recordset will be accessible as read-only, and recordset updates to the host are not possible."
You're concatenating a string here - "SELECT * FROM Customers" & Tabla , but I don't see where Tabla is being provided.
Have you tried running the query directly in Access?
Also, have you tried changing cursortype yet?
http://www.w3schools.com/ado/prop_rs_cursortype.asp

Excel-Access ADO Update Values

I am trying to update a table in Access from the values in excel, however every time i run the code it creates new rows instead of updating the already existing ones, any ideas why? I am new to ADO, so any advised is well appreciated
Private Sub SelectMaster()
Dim db As New ADODB.Connection
Dim connectionstring As String
Dim rs1 As Recordset
Dim ws As Worksheet
Set ws = ActiveSheet
connectionstring = "Provider=Microsoft.Jet.OLEDB.4.0; " & _
"Data Source=C:\Users\Giannis\Desktop\Test.mdb;"
db.Open connectionstring
Set rs1 = New ADODB.Recordset
rs1.Open "Men", db, adOpenKeyset, adLockOptimistic, adCmdTable
r = 6
Do While Len(Range("L" & r).Formula) > 0
With rs1
.AddNew
.Fields("Eva").Value = ws.Range("L" & r).Value
.Update
End With
r = r + 1
Loop
rs1.Close
'close database
db.Close
'Clean up
Set rs1 = Nothing
Set rs2 = Nothing
Set db = Nothing
End Sub
Here are some notes.
An example of updating row by row
''Either add a reference to:
''Microsoft ActiveX Data Objects x.x Library
''and use:
''Dim rs As New ADODB.Recordset
''Dim cn As New ADODB.Connection
''(this will also allow you to use intellisense)
''or use late binding, where you do not need
''to add a reference:
Dim rs As Object
Dim cn As Object
Dim sSQL As String
Dim scn As String
Dim c As Object
scn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=c:\docs\dbto.mdb"
''If you have added a reference and used New
''as shown above, you do not need these
''two lines
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
cn.Open scn
sSQL = "SELECT ID, SName, Results FROM [Test]"
''Different cursors support different
''operations, with late binding
''you must use the value, with a reference
''you can use built-in constants,
''in this case, adOpenDynamic, adLockOptimistic
''see: http://www.w3schools.com/ADO/met_rs_open.asp
rs.Open sSQL, cn, 2, 3
For Each c In Range("A1:A4")
If Not IsEmpty(c) And IsNumeric(c.Value) Then
''Check for numeric, a text value would
''cause an error with this syntax.
''For text, use: "ID='" & Replace(c.Value,"'","''") & "'"
rs.MoveFirst
rs.Find "ID=" & c.Value
If Not rs.EOF Then
''Found
rs!Results = c.Offset(0, 2).Value
rs.Update
End If
End If
Next
An easier option: update all rows
scn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=c:\docs\dbto.mdb"
Set cn = CreateObject("ADODB.Connection")
cn.Open scn
sSQL = "UPDATE [Test] a " _
& "INNER JOIN " _
& "[Excel 8.0;HDR=YES;IMEX=2;DATABASE=C:\Docs\WB.xls].[Sheet1$] b " _
& "ON a.ID=b.ID " _
& "SET a.Results=b.Results"
cn.Execute sSQL, RecsAffected
Debug.Print RecsAffected
Your call to .AddNew is creating new rows.
Fionnuala
Many Thanks for the 'Easier Option' to update all rows.
Just to share that in my case (Office 2007 with Excel file in .xlsm format) I had to change the connection strings in order to reproduce the example:
scn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=c:\docs\dbto.mdb"
...
& "[Excel 12.0 Xml;HDR=YES;IMEX=2;DATABASE=C:\Docs\WB.xls].[Sheet1$] b " _
EDIT: an example updating access row by row (using arrays)
On Error GoTo ExceptionHandling
With Application
'.EnableEvents = False
.ScreenUpdating = False
End With
Dim cnStr As String, sSQL As String, ArId As Variant, ArPrice As Variant, i As Integer, ws As Worksheet, LastRow as Long
Set ws = Sheets("Sheet1")
cnStr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ActiveWorkbook.Path & "\Test.mdb;Jet OLEDB:Database Password=123"
Dim cn As ADODB.Connection
Set cn = New ADODB.Connection
cn.CursorLocation = adUseServer
cn.Open cnStr
Dim cmd As ADODB.Command
Set cmd = New ADODB.Command
Set cmd.ActiveConnection = cn
With ws
LastRow = .Cells(1000, 1).End(xlUp).Row
ArId = Application.Transpose(.Range(.Cells(17, 1), .Cells(LastRow, 1)))
ArPrice = Application.Transpose(.Range(.Cells(17, 3), .Cells(LastRow, 3)))
For i = 1 To UBound(ArId)
If ArPrice(i) = "" Then GoTo ContinueLoop
sSQL = "UPDATE PRICES SET Price = " & Replace(ArPrice(i), ",", ".") & " WHERE Id =" & ArId(i)
cmd.CommandText = sSQL
'For statements that don't return records, execute the command specifying that it should not return any records
'this reduces the internal work, so makes it faster
cmd.Execute , , adCmdText + adExecuteNoRecords
'another option using the connection object
'cn.Execute sSQL, RecsAffected
'Debug.Print RecsAffected
ContinueLoop:
Next i
End With
CleanUp:
On Error Resume Next
With Application
'.EnableEvents = True
.ScreenUpdating = True
End With
On Error Resume Next
Set cmd = Nothing
cn.Close
Set cn = Nothing
Exit Sub
ExceptionHandling:
MsgBox "Error: " & Err.Description & vbLf & Err.Number
Resume CleanUp
Below is an example of a reverse update query: updating a table in Excel from the values in Access.
(tested with Office 2007 and ADO 2.8, excel file in .xlsm format and access file in .mdb format)
Sub Update_Excel_from_Access()
Dim cn As ADODB.Connection
Set cn = New ADODB.Connection
'different options, tested OK
'cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ActiveWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=YES;"";"
'cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ActiveWorkbook.FullName & ";Extended Properties=Excel 12.0 Xml;"
cn.Open "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};DBQ=" & ActiveWorkbook.FullName & ";ReadOnly=0;"
Dim cmd As ADODB.Command
Set cmd = New ADODB.Command
Set cmd.ActiveConnection = cn
cmd.CommandText = "UPDATE [Sheet1$] a " _
& "INNER JOIN " _
& "[;Database=" & ThisWorkbook.Path & "\data.mdb].[Test] b " _
& "ON a.ID=b.ID " _
& "SET a.Results=b.Results"
cmd.Execute , , adCmdText
'Another option, tested OK
'sSQL = "UPDATE [Sheet1$] a " _
' & "INNER JOIN " _
' & "[;Database=" & ThisWorkbook.Path & "\data.mdb].[Test] b " _
' & "ON a.ID=b.ID " _
' & "SET a.Results=b.Results"
'cn.Execute sSQL, RecsAffected
'Debug.Print RecsAffected
Set cmd = Nothing
cn.Close
Set cn = Nothing
End Sub
Below is the same example but using a recordset object:
Sub Update_Excel_from_Access_with_Recordset()
Dim sSQL As String
On Error GoTo ExceptionHandling
Dim cn As ADODB.Connection
Set cn = New ADODB.Connection
cn.CursorLocation = adUseServer
'different options, tested OK
'cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ActiveWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=YES;"";"
'cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ActiveWorkbook.FullName & ";Extended Properties=Excel 12.0 Xml;"
cn.Open "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};DBQ=" & ActiveWorkbook.FullName & ";ReadOnly=0;"
'Create a recordset object
Dim rst As ADODB.Recordset
Set rst = New ADODB.Recordset
sSQL = "SELECT a1.Results As er, a2.Results As ar " _
& "FROM [Sheet1$] a1 INNER JOIN [;Database=" & ThisWorkbook.Path & "\data.mdb].[Test] a2 " _
& " ON a1.[ID] = a2.[ID]"
With rst
.CursorLocation = adUseServer
.CursorType = adOpenKeyset
.LockType = adLockOptimistic
.Open sSQL, cn
If Not rst.EOF Then
Do Until rst.EOF
rst!er = rst!ar
.Update
.MoveNext
Loop
.Close
Else
.Close
End If
End With
CleanUp:
Cancelled = False
On Error Resume Next
cn.Close
Set rst = Nothing
Set cn = Nothing
Exit Sub
ExceptionHandling:
MsgBox "Error: " & Err.description
Resume CleanUp
End Sub