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
Related
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 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.
Please help to fix the following syntax error with Like statement. The query works with = but I need to use Like to search in the AAchange field. I think the problem is here "WHERE [AAchange] LIKE '" & "%" & _
but I'm not sure how to correct this syntax. Please see the code below:
Sub ColorNewVariant()
Dim PolicyNum As Variant
Dim bFound As Boolean
Dim cnn As ADODB.Connection 'dim the ADO collection class
Dim rs As ADODB.Recordset 'dim the ADO recordset class
Dim dbPath As String
Dim strSQL As String
Dim r As Range, cell As Range
Dim LastRow As Long
LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
Application.EnableEvents = False
Set r = ThisWorkbook.ActiveSheet.Range("G3:G" & LastRow)
For Each cell In r
If cell.Value <> "" Then
PolicyNum = cell.Value
dbPath = PATH_MAIN & "\Report\MDL_IonTorrent.accdb"
Set cnn = New ADODB.Connection ' Initialise the collection class variable
'Connection class is equipped with a -method- Named Open
'--4 aguments-- ConnectionString, UserID, Password, Options
'ConnectionString formula--Key1=Value1;Key2=Value2;Key_n=Value_n;
cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dbPath
strSQL = "SELECT [AAchange] " & _
"FROM [MDL_Table1] " & _
"WHERE [AAchange] LIKE '" & "%" & _
Replace(PolicyNum, """", """""", , , vbTextCompare) & _
""""
'Create the ADODB recordset object.
Set rs = New ADODB.Recordset 'assign memory to the recordset
'ConnectionString Open '--5 aguments--
'Source, ActiveConnection, CursorType, LockType, Options
rs.Open strSQL, cnn
bFound = Not rs.EOF
'Check if the recordset is empty.
'Close the recordet and the connection.
rs.Close
cnn.Close
'clear memory
Set rs = Nothing
Set cnn = Nothing
'Enable the screen.
If bFound Then
'MsgBox "Record exists."
Else
'MsgBox "Record not found."
'cell.Interior.ColorIndex = 8
cell.Interior.Color = RGB(255, 217, 218)
'cell.ClearComments
'cell.AddComment "New Variant"
'Fits shape around text
'cell.Comment.Shape.TextFrame.AutoSize = True
End If
End If
Next cell
Application.EnableEvents = True
End Sub
Change the quoting in your query's WHERE clause.
If you use single quotes to start and end the string value you build, you needn't bother with Replace() of double quotes within the PolicyNum value. That should make this task simpler and less confusing ...
strSQL = "SELECT [AAchange] " & _
"FROM [MDL_Table1] " & _
"WHERE [AAchange] LIKE '%" & PolicyNum & "'"
Debug.Print strSQL
I have tables that are created each month to reflect that month's records. I have created vba code that runs a query in excel on multiple months to show changes, new adds, etc. However, I would like the user to be able to choose the two months they would like to compare from an excel drop down box. I am struggling to create dynamic SQL that can do this. Below is my attempted code
`Private Sub ADO_New()
Dim DBFullName As String
Dim Cnct As String, Src As String
Dim Connection As ADODB.Connection
Dim Recordset As ADODB.Recordset
Dim Col As Integer
Dim vCurrentMonth As Variant
Dim vPriorMonth As Variant
Dim wSummary As Worksheet
Set wSummary = Worksheets("Summary")
vCurrentMonth = wSummary.Range("Current_Month").Value
vPriorMonth = wSummary.Range("Prior_Month").Value
Worksheets("New").Cells.ClearContents
DBFullName = ThisWorkbook.Path & "\Guardian_CensusDB.accdb"
Set Connection = New ADODB.Connection
Cnct = "Provider=Microsoft.ACE.OLEDB.12.0;"
Cnct = Cnct & "Data Source=" & DBFullName & ";"
Connection.Open ConnectionString:=Cnct
Set Recordset = New ADODB.Recordset
With Recordset
Src = "SELECT * FROM [vCurrentMonth] LEFT JOIN [vPriorMonth] ON
[vCurrentMonth].[Plan Number] = [vPriorMonth].[Plan Number]" & _
"WHERE ((([vPriorMonth].[Plan Number]) Is Null))"
.Open Source:=Src, ActiveConnection:=Connection
For Col = 0 To Recordset.Fields.Count - 1
Sheets("New").Range("A1").Offset(0, Col).Value = _
Recordset.Fields(Col).Name
Next
Sheets("New").Range("A1").Offset(1, 0).CopyFromRecordset Recordset
End With
Set Recordset = Nothing
Connection.Close
Set Connection = Nothing
End Sub`
You need to concatenate the variables into your string:
Src = "SELECT * FROM [" & vCurrentMonth & "] LEFT JOIN [" & vPriorMonth & "] ON
[" & vCurrentMonth & "].[Plan Number] = [" & vPriorMonth & "].[Plan Number]" & _
"WHERE ((([" & vPriorMonth & "].[Plan Number]) Is Null))"
I am currently using following code to export data from worksheet to MS Access database, the code is looping through each row and insert data to MS Access Table.
Public Sub TransData()
Application.ScreenUpdating = False
Application.EnableAnimations = False
Application.EnableEvents = False
Application.DisplayAlerts = False
ActiveWorkbook.Worksheets("Folio_Data_original").Activate
Call MakeConnection("fdMasterTemp")
For i = 1 To rcount - 1
rs.AddNew
rs.Fields("fdName") = Cells(i + 1, 1).Value
rs.Fields("fdDate") = Cells(i + 1, 2).Value
rs.Update
Next i
Call CloseConnection
Application.ScreenUpdating = True
Application.EnableAnimations = True
Application.EnableEvents = True
Application.DisplayAlerts = True
End Sub
Public Function MakeConnection(TableName As String) As Boolean
'*********Routine to establish connection with database
Dim DBFullName As String
Dim cs As String
DBFullName = Application.ActiveWorkbook.Path & "\FDData.mdb"
cs = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & DBFullName & ";"
Set cn = CreateObject("ADODB.Connection")
If Not (cn.State = adStateOpen) Then
cn.Open cs
End If
Set rs = CreateObject("ADODB.Recordset")
If Not (rs.State = adStateOpen) Then
rs.Open TableName, cn, adOpenKeyset, adLockOptimistic
End If
End Function
Public Function CloseConnection() As Boolean
'*********Routine to close connection with database
On Error Resume Next
If Not rs Is Nothing Then
rs.Close
End If
If Not cn Is Nothing Then
cn.Close
End If
CloseConnection = True
Exit Function
End Function
Above code works fine for few hundred lines of records, but apparently it will be more data to export, Like 25000 records, is it possible to export without looping through all records and just one SQL INSERT statement to bulk insert all data to Ms.Access Table in one go?
Any help will be much appreciated.
EDIT: ISSUE RESOLVED
Just for information if anybody seeks for this, I've done a lots of search and found the following code to be work fine for me, and it is real fast due to SQL INSERT, (27648 records in just 3 seconds!!!!):
Public Sub DoTrans()
Set cn = CreateObject("ADODB.Connection")
dbPath = Application.ActiveWorkbook.Path & "\FDData.mdb"
dbWb = Application.ActiveWorkbook.FullName
dbWs = Application.ActiveSheet.Name
scn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbPath
dsh = "[" & Application.ActiveSheet.Name & "$]"
cn.Open scn
ssql = "INSERT INTO fdFolio ([fdName], [fdOne], [fdTwo]) "
ssql = ssql & "SELECT * FROM [Excel 8.0;HDR=YES;DATABASE=" & dbWb & "]." & dsh
cn.Execute ssql
End Sub
Still working to add specific fields name instead of using "Select *", tried various ways to add field names but can't make it work for now.
is it possible to export without looping through all records
For a range in Excel with a large number of rows you may see some performance improvement if you create an Access.Application object in Excel and then use it to import the Excel data into Access. The code below is in a VBA module in the same Excel document that contains the following test data
Option Explicit
Sub AccImport()
Dim acc As New Access.Application
acc.OpenCurrentDatabase "C:\Users\Public\Database1.accdb"
acc.DoCmd.TransferSpreadsheet _
TransferType:=acImport, _
SpreadSheetType:=acSpreadsheetTypeExcel12Xml, _
TableName:="tblExcelImport", _
Filename:=Application.ActiveWorkbook.FullName, _
HasFieldNames:=True, _
Range:="Folio_Data_original$A1:B10"
acc.CloseCurrentDatabase
acc.Quit
Set acc = Nothing
End Sub
#Ahmed
Below is code that specifies fields from a named range for insertion into MS Access. The nice thing about this code is that you can name your fields in Excel whatever the hell you want (If you use * then the fields have to match exactly between Excel and Access) as you can see I have named an Excel column "Haha" even though the Access column is called "dte".
Sub test()
dbWb = Application.ActiveWorkbook.FullName
dsh = "[" & Application.ActiveSheet.Name & "$]" & "Data2" 'Data2 is a named range
sdbpath = "C:\Users\myname\Desktop\Database2.mdb"
sCommand = "INSERT INTO [main] ([dte], [test1], [values], [values2]) SELECT [haha],[test1],[values],[values2] FROM [Excel 8.0;HDR=YES;DATABASE=" & dbWb & "]." & dsh
Dim dbCon As New ADODB.Connection
Dim dbCommand As New ADODB.Command
dbCon.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & sdbpath & "; Jet OLEDB:Database Password=;"
dbCommand.ActiveConnection = dbCon
dbCommand.CommandText = sCommand
dbCommand.Execute
dbCon.Close
End Sub