Import to Excel from Access table based on two parameters - excel

I am trying to import data from Access to Excel based on two parameters. I have a list of tools which specify a project number (parameter 1) and a tool type (parameter 2). How can I filter out the tools that don't satisfy the user's input of these two parameters?
I saw this thread: Import to Excel from Access table based on parameters
but it doesn't talk about multiple parameters. Here is where I am at so far:
Dim cn As Object
Dim rs As Object
Dim strFile As String
Dim strCon As String
Dim strSQL As String
Dim s As String
Dim i As Integer, j As Integer
''Access database
strFile = "D:\Tool_Database\Tool_Database.mdb"
''This is the Jet 4 connection string, you can get more
''here : http://www.connectionstrings.com/excel
strCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strFile & ";"
''Late binding, so no reference is needed
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
cn.Open strCon
'Find the name of the tool that was selected
Dim SelectedTool As String, SelectedProj
Set SelectedTool = Tools_ListBox.Selected
Set SelectedProj = Project_ListBox.Selected
strSQL = "SELECT * " _
& "FROM ToolFiles " _
& "WHERE Tool_Name = '" & SelectedTool & "'"
rs.Open strSQL, cn, 3, 3
Worksheets("ToolList").Cells(2, 1).CopyFromRecordset rs
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
Obviously the strSQL statement is where I need to get focused and insert the value into SelectedProj.
Thanks!

If you just wanted to add the SelectedProj to the SQL statement, this should be the trick (where ProjectType is the name of the field):
strSQL = "SELECT * " _
& "FROM ToolFiles " _
& "WHERE Tool_Name = '" & SelectedTool & "' " _
& "AND ProjectType = '" & SelectedProj & "'"

The selected property returns True if the item is selected which doesn't make sense in your example above. Perhaps you are looking for something like
SelectedTool = Tools_listbox.Items(Tools_listbox.SelectedItem)
Note you also do not have a declaration for SelectedTool which is naughty but I guess it should be a string in which case you should not use the Set.

Related

Microsoft Access database engine could not find the object Worksheet - ACE OLEDB

I am trying to do a Join on 3 tables in Excel through VBA using Microsoft.ACE.OLEDB.12.0. Having lots of issues trying to get the query to run. At this point I get the following error:
Run-time error '-2147217865 (800040e37)':
The Microsoft Access database engine could not find the object 'CustomSheetName1$A$1:$AV$6027'. Make sure the object exists and that you spell its name and the path name correctly. If 'CustomSheetName1$A$1:$AV$6027' is not a local object, check your network connection or contact the server administrator.
The source file is created in the same sub and saved to the macro root folder located locally in C:\Users\localuser\Documents\MacroFolder\. I have full access to the file.
When run the connection string shows as:
"Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\Users\localuser\Documents\MacroFolder\Book4.xlsx;Extended Properties='Excel 12.0 Xml;HDR=Yes;IMEX=1';"
Extract of sub below. I have obfuscated the field names and only included code I thought was relevant. Can add more and clarify further if required. Code breaks at the last line when executing the query.
Dim wbTarget As Workbook, wsTarget As Worksheet
Dim wb As Workbook, ws As Worksheet
Set wbTarget = Workbooks.Add
Set wsTarget = wbTarget.Sheets.Add(After:=wbTarget.Sheets(wbTarget.Sheets.Count))
wsTarget.Name = "CustomSheetName1"
varFilePathElements = Split(ThisWorkbook.Path, "\")
strFileName = varFilePathElements(UBound(varFilePathElements))
Dim strWBTargetFullFileName As String
strWBTargetFullFileName = Replace(ThisWorkbook.Path, "strfilename", "") & "\" & wbTarget.Name & ".xlsx"
Dim cn As Object
Dim rs As Object
Dim strCon As String
Dim strSQL As String
Dim s As String
Dim i As Integer, j As Integer
strCon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strWBTargetFullFileName _
& ";Extended Properties='Excel 12.0 Xml;HDR=Yes;IMEX=1';"
strSQL = "SELECT " _
& "sh1.company_name, " _
& "sh1.company_type, " _
& "sh1.customer_no, " _
& "sh1.fk1, " _
& "SUM(sh3.total_stat) as total_stat, " _
& "FROM ( [CustomSheetName1" & wbTarget.Sheets("CustomSheetName1").UsedRange.Address & "] sh1 " _
& "LEFT JOIN [CustomSheetName2" & wbTarget.Sheets("CustomSheetName2").UsedRange.Address & "] sh2 " _
& "ON sh2.fk1 = sh1.fk1 ) " _
& "LEFT JOIN [CustomSheetName3" & wbTarget.Sheets("CustomSheetName3").UsedRange.Address & "] sh3 " _
& "ON sh3.fk2 = sh2.fk2 AND sh3.fk3 = sh2.fk3 " _
& "GROUP BY sh1.customer_no, sh1.company_name, sh1.company_type, sh1.fk1 " _
& "ORDER BY total_stat"
wbTarget.Sheets(1).Range("A1").Value2 = strSQL
wbTarget.SaveAs (strWBTargetFullFileName)
wbTarget.Close
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
cn.Open strCon
rs.Open strSQL, cn, 3, 3
Any help would be greatly appreciated. Regards,
When reading Excel worksheets via ADO, the $ sign is appended to the end of the worksheet name, like this:
SELECT * FROM [Sheet1$]
Using the absolute range address adds extra $ signs that cause the worksheet name to be interpreted incorrectly. You need to use non-absolute range addresses to stop this happening. Adding some parameters to UsedRange.Address can fix this:
[CustomSheetName1$" & wbTarget.Sheets("CustomSheetName1").UsedRange.Address(False, False) & "]

Update Excel from MS Access

I tried the code in this link to push and retrieved the data between Excel and Access. I modified the code based on my file path as following:
EDITED NEW CODE BLOCK
Sub UpdateMDB()
Dim accConn As Object, accRST As Object
Dim accFile As String, accStr As String
Dim lastrow As Long, i As Long
lastrow = Workbooks(1).Sheets(1).Cells(Workbooks(1).Sheets(1).Rows.Count, "A").End(xlUp).Row
accFile = "Z:\Documents\Database\Database1.mdb"
accStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & accFile & ";"
Set accConn = CreateObject("ADODB.Connection")
Set accRST = CreateObject("ADODB.Recordset")
accConn.Open accStr
accRST.Open "SELECT * FROM Table1", accConn, adOpenKeyset, adLockOptimistic, adCmdTableDirect
If Not (accRST.BOF And accRST.EOF) Then
accRST.MoveFirst
Else
MsgBox "No records in Access table.", vbInformation
accRST.Close: accConn.Close: Set accRST = Nothing: Set accConn = Nothing
Exit Sub
End If
Do While Not accRST.EOF
For i = 1 To lastrow
If accRST!ID = Workbooks(1).Sheets(1).Range("A" & i) _
And accRST!Field1 <> Workbooks(1).Sheets(1).Range("B" & i) Then
accRST!Field1.Value = Workbooks(1).Sheets(1).Range("B" & i)
End If
Next i
accRST.Update
accRST.MoveNext
Loop
accRST.Close: accConn.Close
Set accRST = Nothing: Set accConn = Nothing
End Sub
INITIAL CODE BLOCK
Sub GetMDB()
Dim cn As Object
Dim rs As Object
strFile = "Z:\Documents\Database\Database1.mdb"
strCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strFile & ";"
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
cn.Open strCon
strSQL = "SELECT * FROM Table1"
rs.Open strSQL, cn
With Worksheets(1)
For i = 0 To rs.Fields.Count - 1
.Cells(1, i + 1) = rs.Fields(i).Name
Next
rs.MoveFirst
.Cells(2, 1).CopyFromRecordset rs
End With
End Sub
Sub UpdateMDB()
Dim cn As Object
Dim rs As Object
''It would probably be better to use the proper name, but this is
''convenient for notes
strFile = Workbooks(1).FullName
''Note HDR=Yes, so you can use the names in the first row of the set
''to refer to columns
strCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strFile _
& ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"";"
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
cn.Open strCon
''Selecting the cell that are different
strSQL = "SELECT * FROM [Sheet1$] s " _
& "INNER JOIN [;Database=Z:\Documents\Database\Database1.mdb;].Table1 t " _
& "ON s.id=t.id " _
& "WHERE s.Field1<>t.Field1"
rs.Open strSQL, cn, 1, 3 ''adOpenKeyset, adLockOptimistic
''Just to see
''If Not rs.EOF Then MsgBox rs.GetString
''Editing one by one (slow)
rs.MoveFirst
Do While Not rs.EOF
rs.Fields("t.Field1") = rs.Fields("s.Field1")
rs.Update
rs.MoveNext
Loop
''Batch update (faster)
strSQL = "UPDATE [;Database=Z:\Documents\Database\Database1.mdb;].Table1 t " _
& "INNER JOIN [Sheet1$] s " _
& "ON s.id=t.id " _
& "SET t.Field1=s.Field1 " _
& "WHERE s.Field1<>t.Field1 "
cn.Execute strSQL
End Sub
Reading data from Access to Excel GetMDB() macro works fine, But when I tried to update the data from Excel to Access, code gives me following error:
Run-time error '3021':
Either BOF or EOF is True, or the current record has been deleted.
Requested operation requires a current record.
I checked the mdb, xlsx and sheet path and names are correct. Anyone got a similar problem as well and how to overcome? Thanks.
You cannot run UPDATE queries using Excel workbook sources as any SQL queries using workbooks are read-only from last saved instance and cannot be updated. Excel simply is not a database to do such transactions with no record-level locking mechanism, read/write access, or relational model. Though you can run append (INSERT INTO ... SELECT *) and make-table queries (SELECT * INTO FROM ...), you cannot run UPDATE that aligns to live values.
However, you can read in an Access recordset and iterate through the Excel cells aligning by ID matches. Below assumes the Excel Sheet's ID column is in Column A and Field1 is in Column B.
Dim accConn As Object, accRST As Object
Dim accFile As String, accStr As String
Dim lastrow As Long, i As Long
Const adOpenKeyset = 1, adLockOptimistic = 3, adCmdTableDirect = 512
lastrow = Workbooks(1).Sheets(1).Cells(Workbooks(1).Sheets(1).Rows.Count, "A").End(xlUp).Row
accFile = "Z:\Documents\Database\Database1.mdb"
accStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & accFile & ";"
Set accConn = CreateObject("ADODB.Connection")
Set accRST = CreateObject("ADODB.Recordset")
accConn.Open accStr
accRST.Open "SELECT * FROM Table1", accConn, adOpenKeyset, adLockOptimistic, adCmdTableDirect
If Not (accRST.BOF And accRST.EOF) Then
accRST.MoveFirst
Else
Msgbox "No records in Access table.", vbInformation
accRST.Close: accConn.Close: Set accRST = Nothing: Set accConn = Nothing
Exit Sub
End If
Do While Not accRST.EOF
For i = 1 to lastrow
If accRST!ID = Workbooks(1).Sheets(1).Range("A" & i) _
And accRST!Field1 <> Workbooks(1).Sheets(1).Range("B" & i) Then
accRST!Field1.Value = Workbooks(1).Sheets(1).Range("B" & i)
End If
Next i
accRST.Update
accRST.MoveNext
Loop
accRST.Close: accConn.Close
Set accRST = Nothing: Set accConn = Nothing
Notes:
If IDs between Excel worksheet and Access table are not one-to-one (i.e., Excel has multiple rows of same ID), the last Field1 value following the If logic will be inserted to corresponding Access row.
Above may be extensive processing if database rows and Excel cells are large. The best option is simply to use Access for all data entry/management and avoid the update needs. Since Excel is a flatfile, consider using it as the end use application and Access as central data repository.

Excel VBA SQL query ADODB

Hi I have an existing Excel sheet with some data inside, and now I want to perform queries directly from VBA. This is what I have now:
Private Sub CommandButton1_Click()
Dim sSQLQry As String
Dim ReturnArray
Dim Conn As New ADODB.Connection
Dim mrs As New ADODB.Recordset
Dim DBPath As String, sconnect As String
Dim newSheet As Worksheet
'DBPath = ThisWorkbook.FullName
DBPath = "C:\someData.xlsm"
sconnect = "Provider=MSDASQL.1;DSN=Excel Files;DBQ=" & DBPath & ";HDR=Yes';"
Conn.Open sconnect
sSQLSting = "SELECT username,count(username) FROM [Sheet1$] group by username order by count(username) desc;"
mrs.Open sSQLSting, Conn
Set newSheet = Sheets.Add
ActiveSheet.Range("A1").CopyFromRecordset mrs
mrs.Close
Conn.Close
End Sub
This query performs well and gives the desired result, but when I change it to this one:
Select param0,count(param0) From [Sheet1$] where eventid='addToCart' group by param0 order by count(param0) desc;
Because the param0 is like this: most of them are numbers, but some of them are numbers and characters mixed together, so the query result only returns the pure-number entries. So how can I configure the database so that it recognizes the param0 field should be text, instead of int? Also, when I perform this query:
Select eventid,param0,param1,count(*) From [Sheet1$] where eventid='search' group by param0, param1 order by count(*) desc;
It gives 'automation error'. I searched for it but could not get a suitable solution. Can anyone help with this? Thank you!
Edit: all the three queries give correct results in MySQL workbench. Now I need to perform the query directly in Excel sheet.
Your second problem lies within the fact that you are asking for the eventid field without including it within the aggregate GROUP BY clause.
SELECT eventid, param0, param1, count(*)
FROM [Sheet1$]
WHERE eventid='search'
GROUP by eventid, param0, param1
ORDER BY COUNT(*) DESC;
I ran your repaired queries against some sample data that I made up and came up with this.
Sub grp_param()
Dim cnx As Object, rs As Object, rs1 As Object
Dim sWS1 As String, sWS2 As String, sWB As String, sCNX As String, sSQL As String
Dim ws1TBLaddr As String
ws1TBLaddr = Worksheets("Sheet4").Cells(1, 1).CurrentRegion.Address(0, 0)
sWS1 = Worksheets("Sheet4").Name
sWB = ThisWorkbook.FullName
'for 64-bit Office
'sCNX = "Provider=Microsoft.Jet.OLEDB.12.0;Data Source=" & sWB _
& ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"";"
'for 32-bit or 64-bit Office
sCNX = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & sWB _
& ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"";"
Debug.Print sCNX
Set cnx = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
Set rs1 = CreateObject("ADODB.Recordset")
cnx.Open sCNX
'Select param0,count(param0) From [Sheet1$] where eventid='addToCart'
' group by param0 order by count(param0) desc;
sSQL = "SELECT param0, COUNT(param0) " & _
"FROM [" & sWS1 & "$" & ws1TBLaddr & "] " & _
"GROUP BY param0 " & _
"ORDER BY count(param0) DESC;"
Debug.Print sSQL
rs.Open sSQL, cnx
With Worksheets.Add(after:=Sheets(Sheets.Count))
.Name = "Summary Data"
.Range("A1").Resize(1, 2) = Array("param0", "count")
.Range("A2").CopyFromRecordset rs
End With
'Select eventid,param0,param1,count(*) From [Sheet1$] where eventid='search'
'group by param0, param1 order by count(*) desc;
sSQL = "SELECT eventid, param0, param1, COUNT(*) " & _
"FROM [" & sWS1 & "$" & ws1TBLaddr & "] " & _
"GROUP BY eventid, param0, param1 " & _
"ORDER BY count(param0) DESC;"
Debug.Print sSQL
rs1.Open sSQL, cnx
With Worksheets(Sheets.Count)
.Range("E1").Resize(1, 3) = Array("eventid", "param0", "count")
.Range("E2").CopyFromRecordset rs1
End With
rs.Close: Set rs = Nothing
rs1.Close: Set rs1 = Nothing
cnx.Close: Set cnx = Nothing
End Sub
I'm unclear on why mySQL allows that last query but my background is in T-SQl and it would certainly choke on that.
For the first confusion, I noticed the post here: link , but I don't want to add in another file for processing, so in the end no other choice, I pre-process the file by adding in 4 lines of texts right below the header line. (As in my case all fields can be text; I did this in MySQL) As the amount of data is quite big, these dummy texts don't affect the result yet help me produce the DB correctly.

Error No value given for one or more required parameters with VBA

I am getting "No value given for one or more required parameters", I am new in Excel VBA, Please suggest what is wrong with the query, Below is the code I am using to get the value from a access data based and I want to have the table name and the table column name on runtime.
Dim con As ADODB.Connection
Dim rs As New ADODB.Recordset
Dim name As String
Dim count As Integer
Dim FindString As String
Dim FindString1 As String
Dim SQLQuery As String
FindString = InputBox("Enter the table name")
FindString1 = InputBox("Enter search value")
count = 4
Dim strConn As String
Set con = New ADODB.Connectioncon.Mode = adModeReadWrite
If con.State = adStateClosed Then
strConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & "databasepath\Database3.accdb;Persist Security Info=False;"
con.ConnectionString = strConn
con.Open
Set rs.ActiveConnection = con
End If
SQLQuery = "select * from " & FindString & " where " & FindString & ".[LOGO] ='" & FindString1 & "'"
rs.Open SQLQuery
Looks like a problem with this SQL query.
"select * from " & FindString & " where [Resolution] = '" & FindString1 & "'"
I would suggest to make an extra step like this.
Dim SQLQuery as String
SQLQuery = "select * from [" & FindString & "] where [Resolution] = '" & FindString1 & "'"
rs.Open SQLQuery
Maybe you can have a look at this solution too.
No value given for one or more required parameters visual basic error

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