VBA excel export to access - excel

Hi I am trying to write a macro that takes the user input from an excel form and adds it to a access table. Using the following code:
Dim cnn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim wsh As Excel.Application
Set cnn = "db.accdb.connection"
Set rst = New ADODB.Recordset
rst.Open "table", cnn, adOpenKeyset, adLockOptimistic, adCmdTableDirect
With rst
.AddNew
.Fields("column1").Value = textboxvar
.Update
End With
with textboxvar previously defined. But it wont work and I don't know why.

after searching for a long time. The top voted post in this thread already answers the question:
Using Excel VBA to export data to MS Access table
This just has to be updated to work with Access 2016:
Public Sub UploadExcel()
Set cn = CreateObject("ADODB.Connection")
dbPath = 'type your database path in here
dbWb = Application.ActiveWorkbook.FullName
dbWs = Application.ActiveSheet.Name
scn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dbPath
dsh = "[" & Application.ActiveSheet.Name & "$]"
cn.Open scn
ssql = "INSERT INTO TableName ([Field1], [Field2], [Field3]) "
ssql = ssql & "SELECT * FROM [Excel 8.0;HDR=YES;DATABASE=" & dbWb & "]." & dsh
cn.Execute ssql
End Sub

Example that declares, sets, opens connection:
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Set cn = New ADODB.Connection
Set rs = New ADODB.Recordset
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0; DataSource='C:\path\databasename.accdb'"
rs.Open "SELECT * FROM MyTable", cn, adOpenKeyset, adLockOptimistic

Related

Run time error '3706': Provider cannot be found - Excel VBA "Provider=Microsoft.Jet.OLEDB.4.0"

I saw that this error isn't new, but I can't find the solution.
I have one xls file that use one sheet like as db and with ADODB i get the recordsets that I need.
The code is Very simple and work right for each pc(5) that I tested, with WIN7, WIN10, 32 or 64 bit.
But I've on PC, it's customer Pc, that get me this error: Run time error '3706': Provider cannot be found,
I has checked the WIN version, the office version, they are the same like other PC, WIN10 64 Bit, MS Office 32Bit
There are more control that I've to do to resolve this problem?!?!
thanks for any suggestions
fabrizio
My xls file have 2 sheet, 1th named "dati" with two columns (Anno, Pezzi), 2th named "test" empty, this is the code:
Sub testConn()
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim strsql As String
Const adOpenStatic = 3
Const adLockOptimistic = 3
Const adCmdText = &H1
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
Set rs = New ADODB.Recordset
#If Win64 Then
cn.Open "Provider=Microsoft.Jet.OLEDB.12.0; Data Source=" & ThisWorkbook.FullName & "; Extended Properties=""Excel 8.0;HDR=Yes;"";"
#Else
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & ThisWorkbook.FullName & "; Extended Properties=""Excel 8.0;HDR=Yes;"";"
#End If
strsql = "SELECT anno, Sum(Pezzi)as Tpz from [dati$] group by anno"
rs.Open strsql, cn, adOpenStatic, adLockReadOnly, adCmdUnspecified
rs.MoveFirst
With Worksheets("test")
.Cells.ClearContents
.Range("A1") = "Anno"
.Range("B1") = "T.Pz"
.Range("A2").CopyFromRecordset rs
.Activate
.Select
End With
End Sub
these references was added into file:
Microsoft ActiveX Data Objects 6.1 Library
Microsoft ActiveX Data Recordset 2.8 Library
This works, there are some small details you use not suitable. Version 12, driver is ace not jet,and Extended Properties also is Excel 12.0
And no need to add library.
Sub testConn()
Dim cn As Object
Dim rs As Object
Dim strsql As String
Dim connString
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
If Application.Version < 12 Then
connString = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & ThisWorkbook.FullName & "; Extended Properties=""Excel 8.0;HDR=Yes;"";"
Else
connString = "Provider=Microsoft.ACE.OLEDB.12.0; Data Source=" & ThisWorkbook.FullName & "; Extended Properties=""Excel 12.0;HDR=Yes;"";"
End If
cn.Open connString
strsql = "SELECT anno, Sum(Pezzi) as Tpz from [dati$] group by anno"
Set rs = cn.Execute(strsql)
With Worksheets("test")
.Cells.ClearContents
.Range("A1") = "Anno"
.Range("B1") = "T.Pz"
.Range("A2").CopyFromRecordset rs
.Activate
.Select
End With
End Sub

how to combine two different database table with ADO?

Is it possible to combine an Oracle table and Access table in one recordset with ADO?
I can do it with two Access table but not able to do with one Oracle and one Access.
any help would be appreciated.
EDIT
Working code with two access
Sub twoDB()
Dim con As ADODB.Connection
Dim strDB1 As String
Dim strDB2 As String
Dim rs As ADODB.Recordset
Set con = New ADODB.Connection
strDB1 = ".......\daotest.accdb"
strDB2 = ".......\daotest2.accdb"
mysql = "select * from [" & strDB1 & "].şubeler inner join [" & strDB2 & "].şb on (şb.şb=şubeler.SubeKodu)"
With con
.ConnectionString = "Provider = Microsoft.ACE.OLEDB.12.0; data source=" & strDB2 'oledb, odbc için: con.ConnectionString = "Driver={Microsoft Access Driver (*.mdb, *.accdb)};Dbq=" & strDB 'odbc
.Mode = adModeWrite
.Open
End With
Set rs = New ADODB.Recordset
rs.Open mysql, con, adOpenDynamic, adLockReadOnly
ActiveCell.CopyFromRecordset rs
End Sub
Non-Working code with one access and one oracle
Sub twoDBOneOracleOneAccess()
Dim con As ADODB.Connection
Dim strDB2 As String
Dim rs As ADODB.Recordset
Set con = New ADODB.Connection
strDB2 = "....\daotest2.accdb"
mysql = "select MUSTERI_ID,MUSTERI_BAGLI_OLDUGU_SUBE_ID from OracleTable a inner join [" & strDB2 & "].şb on (şb.şb=a.MUSTERI_BAGLI_OLDUGU_SUBE_ID) where A.MESLEK_KODU=2041"
With con
.ConnectionString = "Provider=OraOLEDB.Oracle;Data Source........;"
.Open
End With
Set rs = New ADODB.Recordset
rs.Open mysql, con, adOpenKeyset, adLockOptimistic
ActiveCell.CopyFromRecordset rs
End Sub

Excel VBA SQL. Is there a limit on rows which can be queried, or on recordset contents?

I'm using VBA in Windows 7 Excel 2016 to query an Excel table with SQL. The worksheet containing the data has over 200,000 rows.
I'm using the ActiveX Data Objects 6.1 library. Here's the code:
Private Sub TestADO()
Dim objConnection As ADODB.Connection
Dim objRecordset As ADODB.Recordset
Dim strCon As String
Dim strSQL As String
Dim strPath As String
Dim strSource As String
Set objConnection = CreateObject("ADODB.Connection")
Set objRecordset = CreateObject("ADODB.Recordset")
Sheet2.UsedRange.Clear
strPath = ThisWorkbook.Path & "\"
strSource = ThisWorkbook.Name
strCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source='" & strPath & strSource & "';" & _
"Extended Properties=""Excel 8.0;HDR=Yes;"";"
strSQL = "Select * FROM [Sheet1$] " 'I've tried many queries, all have same problem
objConnection.Open strCon
objRecordset.Open strSQL, objConnection, adOpenStatic, adLockOptimistic, adCmdText
If Not objRecordset.EOF Then
Sheet2.Range("A1").CopyFromRecordset objRecordset
End If
End Sub
This works OK, except that any SQL query only searches in the first 36,201 rows of the data sheet. Is there a limit on the number of rows which can be searched, or on recordset contents, or am I doing something wrong?

How to copy a powerpivot table down to an excel sheet with vba?

I need to get my table up in the powerpivot model down to the excel worksheet.
So far I have tried to use a Recordset but I cant get an ActiveConnection to the powerpivot table. Is it possible? Or is there an other better way to do this?
I use the following code:
Dim name As ADODB.Recordset
Set name = New ADODB.Recordset
With name
.ActiveConnection = ConnectionName
.Source = "TableName"
.LockType = adLockReadOnly
.CursorType = adOpenForwardOnly
.Open
End With
But with this piece of code I get an error at .ActiveConnection. (Run-time error 3001, it complains about non-allowed connection interval)
This is an example of how to read the records from a named range (assuming 'TableData' is named range).
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Set cn = New ADODB.Connection
Set rs = New ADODB.Recordset
With cn
.Provider = "Microsoft.ACE.OLEDB.12.0"
.ConnectionString = "Data Source=" & ThisWorkbook.FullName & ";" & _
"Extended Properties=Excel 8.0;"
.Open
End With
rs.Open "SELECT * FROM [TableName]", cn
Dim r
For Each r In rs.GetRows
'Do whatever you want per record
Debug.Print r
Next r
rs.Close
cn.Close

Run access query from Excel and pass parameters to the query

How to execute a query in MS Access db from Excel VBA code or macro.
MS-Access query accepts some parameters, that needs to be passed from Excel.
Thanks
Here is one possibility:
Dim cn As Object
Dim strFile As String
Dim strCon As String
Dim strSQL As String
strFile = "C:\docs\Test.mdb"
strCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strFile
''Late binding, so no reference is needed
Set cn = CreateObject("ADODB.Connection")
cn.Open strCon
strSQL = "INSERT INTO ATable (AField) " _
& "VALUES (" & Sheet1.[A1] & ")"
cn.Execute strSQL
cn.Close
Set cn = Nothing
You can also refer in-line in the sql to a dataset from Excel.
EDIT re comments
Using a command:
strSQL = "SELECT * FROM ATable " _
& "WHERE AField = #AField"
With cmd
Set .ActiveConnection = cn
.CommandText = strSQL
.CommandType = 1 'adCmdText
''ADO Datatypes are often very particular
''adSmallInt = 2 ; adParamInput = 1
.Parameters.Append .CreateParameter("#AField", 2, 1, , Sheet1.[A1])
End With
Set rs = cmd.Execute
See also: http://support.microsoft.com/kb/181782
This uses ADODB.
Set m_Connection = New Connection
If Application.Version = "12.0" Then
m_Connection.Provider = "Microsoft.ACE.OLEDB.12.0"
Else
m_Connection.Provider = "Microsoft.Jet.OLEDB.4.0"
End If
m_Connection.Open <full path to Access DB>
If m_Connection.State > 0 Then
Dim rsSource As New Recordset
rsSource.Open strQuery, m_Connection, adOpenForwardOnly, adLockReadOnly
Dim result As Long
Dim rngTarget As Range
rngTarget = ThisWorkbook.Worksheets(m_SheetName).Range("A1")
If Not rsSource.BOF Then
result = rngTarget.CopyFromRecordset(rsSource)
End If
If rsSource.State Then rsSource.Close
Set rsSource = Nothing
End If
So it runs the query and puts it where you like. strQuery is the name of a query in the db or an SQL string.

Resources