With the below code i get the following error when ran provider cannot be found, The below code is copied and edited from the net, It previously used .mdb files but I tried to change it to .accdb because thats the format I need it in. I'm trying to make a macro that when ran copies certain cells into a database, adding to it.
I get this error
run-time error "3706"
Provider cannot be found it may not be properly installed
-
Const TARGET_DB = "testdb.accdb"
Sub AlterOneRecord()
Dim cnn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim fld As ADODB.Field
Dim MyConn
Dim lngRow As Long
Dim lngID As String
Dim j As Long
Dim sSQL As String
'determine the ID of the current record and define the SQL statement
lngRow = ActiveCell.Row
lngID = Cells(lngRow, 1).Value
sSQL = "SELECT * FROM tblPopulation WHERE PopID = " & lngID
Set cnn = New ADODB.Connection
MyConn = ThisWorkbook.path & Application.PathSeparator & TARGET_DB
With cnn
.Provider = "Provider=Microsoft.ACE.OLEDB.12.0;"
.Open MyConn
End With
Set rst = New ADODB.Recordset
rst.CursorLocation = adUseServer
rst.Open Source:=sSQL, _
ActiveConnection:=cnn, _
CursorType:=adOpenKeyset, _
LockType:=adLockOptimistic
'Load contents of modified record from Excel to Access.
'do not load the ID again.
For j = 2 To 7
rst(Cells(1, j).Value) = Cells(lngRow, j).Value
Next j
rst.Update
' Close the connection
rst.Close
cnn.Close
Set rst = Nothing
Set cnn = Nothing
End Sub
Is there an easier way to do this? or should I try and fix this?
What you are missing is complete connection string to your data base file.
(More about connection string)
I give you a rough idea which usually works with my code:
remove this line in your code:
.Provider = "Provider=Microsoft.ACE.OLEDB.12.0;"
instead use this one:
.ConnectionString= "Provider=Microsoft.ACE.OLEDB.12.0;"
or you could use this one instead:
.Provider = "Microsoft.ACE.OLEDB.12.0"
For further information you could see this w3schools website.
Related
I have a macro that pulls a sample of data from Access. The Access data first column [ID] is sorted numerically from 1 to the end of data. The macro below takes user's input (start point and end point) to get a sample.
It sometimes returns the data not sorted as in the database. For example, if I enter start point 3,500 and end point 3,999. The first row of data in excel is 3533 to 3,627. Then the next row is 3,500 to 3,532. Then 3,628 to 3,999.
The problem is consistent at the same start/end points.
I went through the database and there are no issues.
Sub GetAccessData(StartofData As Long, EndofData As Long, WS As Worksheet, WB_Path As String)
Dim DBFullName As String
Dim Connect As String, Source As String
Dim Connection As ADODB.Connection
Dim Recordset As ADODB.Recordset
Dim Col As Long
Dim x As Long
Application.ScreenUpdating = False
'DataBase Path
DBFullName = WB_Path & "\RawData - Template.accdb"
'Open the Connection
Set Connection = New ADODB.Connection
Connect = "Provider=Microsoft.ACE.OLEDB.12.0;"
Connect = Connect & "Data Source=" & DBFullName & ";"
Connection.Open ConnectionString:=Connect
'Create a RecordSet
Set Recordset = New ADODB.Recordset
' Client-side cursor
Recordset.CursorLocation = adUseClient
With Recordset
Source = "SELECT * FROM CT_RawData WHERE [ID] BETWEEN " & StartofData & " AND " & EndofData
.Open Source:=Source, ActiveConnection:=Connection
'WS.Activate
On Error Resume Next
WS.Range("A3").CopyFromRecordset Recordset
'Sheets("Chart1").Activate
End With
End Sub
I need a small help. I have an Access file name "DB_MLL.accdb" with table name "tblMLL" total 31 columns including primary key. I'm using front-end Excel and back-end access to fetch the data. I have two buttons to pull data from Acess and push back to access. Pulling data from access is working fine but pushing back is not working. I'm using the below codes. request you please guide me where I am doing wrong.
Sub PushTableToAccess()
Dim cnn As ADODB.Connection
Dim MyConn
Dim rst As ADODB.Recordset
Dim i As Variant, j As Variant
Dim Rw As Long
Sheets("Data").Activate
Rw = Range("A65536").End(xlUp).Row
Set cnn = New ADODB.Connection
MyConn = ThisWorkbook.Path & Application.PathSeparator & TARGET_DB
With cnn
.Provider = "Microsoft.ACE.OLEDB.12.0"
.Open MyConn
End With
Set rst = New ADODB.Recordset
rst.CursorLocation = adUseServer
rst.Open Source:="tblMLL", ActiveConnection:=cnn, _
CursorType:=adOpenDynamic, LockType:=adLockOptimistic, _
Options:=adCmdTable
'Load all records from Excel to Access.
For i = 3 To Rw
rst.AddNew
For j = 1 To 31
If Cells(i, j).Value = "" Then
rst(Cells(2, j).Value) = ""
Else
rst(Cells(2, j).Value) = Cells(i, j).Value
End If
Next j
rst.Update
Next i
' Close the connection
rst.Close
cnn.Close
Set rst = Nothing
Set cnn = Nothing
MsgBox "Data Upload Completed successfully."
End Sub
Your code seems to have a bit of a fix.
Sub PushTableToAccess()
Dim cnn As ADODB.Connection
Dim MyConn
Dim rst As ADODB.Recordset
Dim i As Variant, j As Variant
Dim Rw As Long
Dim strConn As String
Sheets("Data").Activate
Rw = Range("A65536").End(xlUp).Row
Set cnn = New ADODB.Connection
MyConn = ThisWorkbook.Path & Application.PathSeparator & TARGET_DB
strConn = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & MyConn
cnn.Open strConn
Set rst = New ADODB.Recordset
wirh rst
.CursorLocation = adUseServer
.Source = "tblMLL"
.Options = adCmdTable
.ActiveConnection = strConn
.CursorType = adOpenDynamic
.LockType = adLockOptimistic
.Open
'Load all records from Excel to Access.
For i = 3 To Rw
.AddNew
For j = 1 To 31
If Cells(i, j).Value = "" Then
.Fields(Cells(2, j).Value) = ""
Else
.Fields(Cells(2, j).Value) = Cells(i, j).Value
End If
Next j
.Update
Next i
End With
' Close the connection
rst.Close
cnn.Close
Set rst = Nothing
Set cnn = Nothing
MsgBox "Data Upload Completed successfully."
End Sub
I am getting error 3705 after adding the line
[MTSU_Data].[Tool no]=" CInt(WsInput.Range("J" & c).value) & ";"
The highlighted line where the error occurs is at
.ActiveConnection = conn
Full code
Dim conn As ADODB.Connection
Dim Accdata As ADODB.Recordset
Dim Accfield As ADODB.Field
Dim wsQueryR As Worksheet, wsFinal As Worksheet
Set wsFinal = Worksheets("Final")
Set conn = New ADODB.Connection
Set Accdata = New ADODB.Recordset
conn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\Users\wongki7\Desktop\MTSU Db.accdb;"
conn.Open
'G:\BusUnits\MTSU\MTSU\Mold Tool Set Up\MTSU Reports\Shift Reports\MTSU Db.accdb;"
' On Error GoTo CloseConnection
For c = 2 To WsInput.Range("J" & Rows.Count).End(xlUp).Row
With Accdata
.ActiveConnection = conn
.Source = "SELECT * FROM [MTSU_Data] Where [MTSU_Data].[Date]>= #" _
& Format(CDate(WsInput.Range("A2").value), "mm/dd/yyyy") & " # AND [MTSU_Data].[Date]<= #" _
& Format(CDate(WsInput.Range("A3").value), "mm/dd/yyyy") & " # AND [MTSU_Data].[LT] = " _
& CInt(WsInput.Range("M2").value) & " AND [MTSU_Data].[Tool no]=" _
& CInt(WsInput.Range("J" & c).value) & ";"
.LockType = adLockReadOnly
'.CursorType = adOpenForwardOnly
.Open
End With
Next
Worksheets("Result").Select
Sheets("Result").Range("a2").CopyFromRecordset Accdata
Accdata.Close
conn.Close
Any help is appreciated. Thanks and have a good day ahead.
Can you not try to move the line
.ActiveConnection = conn
To outside the loop. Obviously fully qualifying it..
Accdata.ActiveConnection = conn
That looks to me that you are trying to make the connection for each iteration and I think it is only necessary once... maybe.
To best fit your code, Id try something like:
Sub SomeRoutine()
Dim conn As ADODB.Connection
Dim Accdata As ADODB.Recordset
Dim Accfield As ADODB.Field
Dim wsQueryR As Worksheet, wsFinal As Worksheet
Dim c As Long
Set wsFinal = Worksheets("Final")
Set conn = New ADODB.Connection
Set Accdata = New ADODB.Recordset
conn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\Users\wongki7\Desktop\MTSU Db.accdb;"
conn.Open
Accdata.ActiveConnection = conn
Accdata.LockType = adLockReadOnly
For c = 2 To WsInput.Range("J" & Rows.Count).End(xlUp).Row
Call Accdata.Open("SELECT * FROM BLah Blah")
Sheets("Result").Range("a2").CopyFromRecordset Accdata
Accdata.Close
Next
conn.Close
End Sub
You may be able to look at the way you build the SQL request to build a query to get the data in one go and and do a single paste to Excel with the CopyFromRecordset.... but that's a different issue.
A mistake I've made many times before. When assigning objects, you need to use Set. Change the line to
Set .ActiveConnection = conn
.Source and .LockType are scalar properties, so they don't need Set, but .Activeconnection does.
I have a Userform in Excel with four textboxes. Each text box corresponds to a field of Table1 in Access.
I’m would like to return MAX row ID value from a table in Access, add 1 to that value, and to display that value in a textbox on the userform.
After I enter values into the other 3 text boxes, I would like to export data to Table1 in Access.
Can this all be accomplished in the same subroutine? Please help me incorporate sql statement in the correct location in the code.
Thank you
Dim cnn As ADODB.Connection 'dim the ADO collection class
Dim rst As ADODB.Recordset 'dim the ADO recordset class
Dim dbPath As String
Dim x As Long, i As Long
Dim PrimaryField As String
Dim MyTable As String
Dim GetLastPrimaryKey As Variant
PrimaryField = "ID"
MyTable = "Table1"
'Erro handler
On Error GoTo errHandler:
'dbPath = ActiveSheet.Range("H500").Value
dbPath = "H:\Annie\File.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
sql = "SELECT MAX([" & PrimaryField & "]) FROM [" & MyTable & "];"
'two primary providers used in ADO SQLOLEDB —-Microsoft.JET.OLEDB.4.0 —-Microsoft.ACE.OLEDB.12.0
'Object Linking and Embedding, Database
'ADO library is equipped with a class named Recordset
Set rst = New ADODB.Recordset 'assign memory to the recordset
'ConnectionString Open '—-5 aguments—-
'Source, ActiveConnection, CursorType, LockType, Options
rst.Open Source:="Table1", ActiveConnection:=cnn, _
CursorType:=adOpenDynamic, LockType:=adLockOptimistic, _
Options:=adCmdTable
'rst.Open sql, cnn
GetLastPrimaryKey = rst.Fields(0).Value
MsgBox (GetLastPrimaryKey)
GetLastPrimaryKey = Arec1.Value
'you now have the recordset object
'alternative code
With rst
.AddNew
.Fields("ID").Value = Arec1
.Fields("patient").Value = Arec2
.Fields("test").Value = Arec3
.Fields("CommentTxt").Value = Arec4
.Update
End With
'clear the userform values
For x = 1 To 4
UserForm1.Controls("Arec" & x).Value = ""
Next
'add the next user ID
'Me.Arec1 = Sheet1.Range("J3").Value
' Close the connection
rst.Close
cnn.Close
Set rst = Nothing
Set cnn = Nothing
'commuinicate with the user
MsgBox " The data has been successfully sent to the access database"
On Error GoTo 0
Exit Sub
errHandler:
Set rst = Nothing
Set cnn = Nothing
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure cmdAdd"
End Sub
Consider opening a new recordset. Of course, change the Excel userform textbox name (placeholder here):
Set maxIDrst = New ADODB.Recordset
sql = "SELECT MAX([" & PrimaryField & "]) + 1 as MaxIDPlusOne FROM [" & MyTable & "];"
maxIDrst.Open sql, conn
UserForm1.Controls("Arec5").Value = maxIDrst!MaxIDPlusOne
maxIDrst.Close
...
Set maxIDrst = nothing
Please help me create a user defined function in excel vba
example
Function GetTheValue(wbPath, wbName, wsName, cellRef)
Dim cnn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim tmp As Range
Set cnn = New ADODB.Connection
Set rst = New ADODB.Recordset
cnn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & wbPath & wbName & ";" & _
"Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"""
rst.Open "SELECT * FROM [" & wsName & "$" & cellRef & "]", cnn
Set tmp = Range("L5")
tmp.CopyFromRecordset rst
MsgBox tmp.Value
GetTheValue = tmp.Value
rst.Close
cnn.Close
Set rst = Nothing
Set cnn = Nothing
End Function
I tryed to use this in cell by signing formula
=GetThaValue("D:\";"test.xls";"Sheet1";"B4")
and see that the string "tmp.CopyFromRecordset rst" of my code did not work
Please can you help me resolve this question.
Thanks a lot
If you want to call this function from any excel cell there are some changes required.
First- I made some test and it seems to be not allowed to point single cell in SQL statement, therefore it will be required to call your function in this way:
=GetThaValue("D:\";"test.xls";"Sheet1";"B4:B5")
where first cell B4 will be one you search.
Second- The function slightly improved with some comments inside looks as follows:
Function GetTheValue(wbPath, wbName, wsName, cellRef)
Dim cnn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim tmp As Range
Set cnn = New ADODB.Connection
Set rst = New ADODB.Recordset
'some changes here according to www.ConnectionStrings.Com
cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & wbPath & wbName & ";" & _
"Extended Properties=""Excel 8.0;"""
rst.Open "SELECT * FROM [" & wsName & "$" & cellRef & "]", cnn
'Set tmp = Range("L5") 'NOT needed here
'tmp.CopyFromRecordset rst 'NOT allowed if function is called from Excel
'MsgBox tmp.Value 'NOT necessary in this function
'NEW- in this way we get value of your cell and pass it to excel
GetTheValue = rst.Fields(0).Value
rst.Close
cnn.Close
Set rst = Nothing
Set cnn = Nothing
End Function
I can confirm it's tested for Excel 2010 and it's working fine.