I am having trouble getting data from an Access Database. I found this code online, and it seems to work (to an extent), but for some reason it will only pull the column headers, and none of the data from the query. I am not too familiar with Access, that is why I pulled one from offline.
Someone had a similar post a while back, where the code they used was the same, and our queries were exactly the same, but we had different issues.
Importing Data From Access Using Excel VBA
Would anyone happen to know why the data won't pull?
Sub getDataFromAccess()
Dim DBFullName As String
Dim Connect As String, Source As String
Dim Connection As ADODB.Connection
Dim Recordset As ADODB.Recordset
Dim Col As Integer
Dim startdt As String
Dim stopdt As String
Dim refresh
refresh = MsgBox("Start New Query?", vbYesNo)
If refresh = vbYes Then
Sheet1.Cells.Clear
startdt = Application.InputBox("Please Input Start Date for Query (MM/DD/YYYY): ", "Start Date")
stopdt = Application.InputBox("Please Input Stop Date for Query (MM/DD/YYYY): ", "Stop Date")
DBFullName = "X:\MyDocuments\CMS\CMS Database.mdb"
' Open the connection
Set Connection = New ADODB.Connection
Connect = "Provider=Microsoft.ACE.OLEDB.12.0;"
Connect = Connect & "Data Source=" & DBFullName & ";"
Connection.Open ConnectionString:=Connect
Set Recordset = New ADODB.Recordset
With Recordset
Source = "SELECT * FROM Tracking WHERE [Date_Logged] BETWEEN " & startdt & " AND " & stopdt & " ORDER BY [Date_Logged]"
.Open Source:=Source, ActiveConnection:=Connection
For Col = 0 To Recordset.Fields.Count - 1
Range(“A1”).Offset(0, Col).Value = Recordset.Fields(Col).Name
Next
Range(“A1”).Offset(1, 0).CopyFromRecordset Recordset
End With
ActiveSheet.Columns.AutoFit
Set Recordset = Nothing
Connection.Close
Set Connection = Nothing
End Sub
An easy way to get data in Excel, especially from Access, is to use the menu "Data > Access". This creates a connection to a table, that you can freely edit.
At the very least, that is a convenient way to limit your investigations to:
the query you typed (the connection string will always be OK, so if you're getting no values, it comes from the query)
or the VBA itself (if the table is returning values but not the corresponding VBA Sub, then you know it comes from the VBA itself, not the SQL).
I'm skipping the creation of connection becuse it's really straightforward; it's better to focus on what you can do once the table has been created.
Edit the connection
When you select the table and go to menu "Data > Properties", then in the window you click on the top right button "Connection properties", you get to the definition of the connection, i.e. some properties in the first tab and the actual definition in the second tab.
If you move the .mdb file, you'll have to change the connection string accordingly. There should be no other events forcing you to alter it.
If you want to type an actual complex query, you'll need to:
Change the command type from "Table" to "SQL"
Type the query in the bottom edit box.
Note if you want to define dynamic parameters in the WHERE clause, you can put question marks (?) instead of hardcoded values. Question marks can be linked to either constants (with a prompt to change their values) or cell.
Use in VBA
Once you checked with the connection that everything works, you have 2 solutions to put that in VBA.
Either use exactly the code you have above; in that case, you can make things easy by simply copying the connection string and the query.
Alternatively and this is what I would recommend, the table we have built previously can be updated very easily in VBA.
Use this piece of code:
WorksheetWithTable.ListObjects(1).QueryTable.Refresh
You really don't need more than this 1 line of code to do the refresh.
If you set your query to automatically refresh when a cell's value is being modified, then you do not even need it at all.
Note #1: Instead of an index in .ListObjects(1), you can use the table name.
Node #2: Refresh has an optional parameters to drive if the query is to be refresh in the background. True means the VBA code will not wait for the execution to end before moving to the next instruction. False, obviously, is the opposite.
The posted code is missing End If line. Perhaps this is just a posting typo because code should not compile and run.
The query SQL needs # delimiters for the date parameters:
Source = "SELECT * FROM Tracking WHERE [Date_Logged] BETWEEN #" & startdt & "# AND #" & stopdt & "# ORDER BY [Date_Logged]"
Text field would need apostrophe delimiters. Number field does not need delimiters.
I solved the answer to my own question after hours, i found a different set of code that worked fine. Thank you all for your help!
Sub getdatamdb()
Dim cn As Object, rs As Object
Dim intColIndex As Integer
Dim DBFullName As String
Dim TargetRange As Range
10 DBFullName = "X:\MyDocuments\CMS\CMS Database.mdb"
20 On Error GoTo Whoa
30 Application.ScreenUpdating = False
40 Set TargetRange = Sheets("Sheet1").Range("A1")
50 Set cn = CreateObject("ADODB.Connection")
60 cn.Open "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & DBFullName & ";"
70 Set rs = CreateObject("ADODB.Recordset")
80 rs.Open "SELECT * FROM Tracking WHERE [Date_Logged] BETWEEN #" & startdt & "# AND #" & stopdt & "# ORDER BY [Date_Logged]", cn, , , adCmdText
' Write the field names
90 For intColIndex = 0 To rs.Fields.Count - 1
100 TargetRange.Offset(1, intColIndex).Value = rs.Fields(intColIndex).Name
110 Next
' Write recordset
120 TargetRange.Offset(1, 0).CopyFromRecordset rs
LetsContinue:
130 Application.ScreenUpdating = True
140 On Error Resume Next
150 rs.Close
160 Set rs = Nothing
170 cn.Close
180 Set cn = Nothing
190 On Error GoTo 0
200 Exit Sub
Whoa:
210 MsgBox "Error Description :" & Err.Description & vbCrLf & _
"Error at line :" & Erl & vbCrLf & _
"Error Number :" & Err.Number
220 Resume LetsContinue
End If
End Sub
Related
I'm new to VBA and am writing a macro that downloads data from Access based on a month-end date entered by the user.
Currently, I am having issues getting information to download from Access.
To be more specific: when I run the macro and enter in the month-end date, no data is downloaded but I also receive no error messages.
I have been trying different code iterations to try to get it to work. Before I was getting various error messages; now I get no error messages but no data downloads.
I was reading online that I need to use a function to get my variable from the input box (box) to work in the Access query. I am wondering if it has to do with how I have my function set up. Or is there an issue with my Access query.
Sub Expense_Download()
'
' Expense_Download Macro
'
Dim cnn As ADODB.Connection, rs As ADODB.Recordset, sQRY As String, strFilePath As String, box As Variant, myvar As Variant
strFilePath = "C:\Users\NVanWyk\Documents\Fidato\Lunch And Learn\Lunch and Learn Access DB\Nate's Expenses DB.accdb" 'Replace the ‘DatabaseFolder’ and ‘myDB.accdb’ with your DB path and DB name
Set cnn = New ADODB.Connection
Set rs = New ADODB.Recordset
box = InputBox("What month do you want expense data for? Please use the MM/DD/YYYY format.", "Expense Month?")
If Not IsDate(box) Then MsgBox "Value entered is not a valid date, please try again.", , "Input Value is Not Correct"
End
myvar = box
cnn.Open "provider = microsoft.ace.oledb.12.0;" & _
"Data Source=" & strFilePath & ";"
'have to indent the data source or the code does not run
sQRY = "SELECT * FROM Expenses Where Expenses.Expense_Month=myvar()" 'Replace ‘tblData’ with your Access DB Table name or Query name from which you want to download the data"
rs.CursorLocation = adUseClient
rs.Open myvar(), sQRY, cnn, adOpenStatic, adLockReadOnly
Application.ScreenUpdating = False
Sheet1.Range("A2").CopyFromRecordset rs
'sheet 1 for whatever reason still pastes to the "expense" sheet
rs.Close
Set rs = Nothing
cnn.Close
Set cnn = Nothing
Exit Sub
End Sub
First of all, the line that contains the word 'End' only, will stop execution.
If you want to stop execution in case of wrong user input, do this:
If Not IsDate(box) Then
MsgBox "Value entered is not a valid date, please try again.", , "Input Value is Not Correct"
End 'or Exit Sub
End If
You store the user's month input in myvar variable but then you don't actually put into the select query.
Instead of this:
sQRY = "SELECT * FROM Expenses Where Expenses.Expense_Month=myvar()"
Try this:
sQRY = "SELECT * FROM Expenses Where Expenses.Expense_Month= " & myvar
However, the value you are expecting in InputBox is not obvious. I'm assuming that it's a number between 1 and 12 and Expense_Month field is a number too in your database.
In case it contains the year too in YYYY-MM format and is a varchar, you will need to change your code like this:
sQRY = "SELECT * FROM Expenses Where Expenses.Expense_Month= '" & myvar & "'"
Either of the above is true, IsDate is not the right function to check whether the input is correct. For example if the user types 20 into the box, it will return True as it is a date but January 20 of 1900.
Also, remove the first parameter myvar() from this line.
rs.Open myvar(), sQRY, cnn, adOpenStatic, adLockReadOnly
rs.Open sQRY, cnn, adOpenStatic, adLockReadOnly
Based on your additional input I recommend using YYYY-MM-DD as user input. So your query would be defined as:
sQRY = "SELECT * FROM Expenses Where Expenses.Expense_Month= '" & myvar & "'"
To test your query, open Locals windows in VB editor, see what the value of sQRY is once execution reaches this point and run that in Access's SQL editor to see if it is going to work.
Thanks for the help everyone!
I made the edits above and did some other research and was able to get the code to work. I think the snag was because I was using a date (MM/DD/YYYY) as the variable, I needed to add the # signs in the query so that Access recognized the variable as a date.
Sub Expense_Download()
'
' Expense_Download Macro
'
Dim cnn As ADODB.Connection, rs As ADODB.Recordset, sQRY As String, strFilePath As String, box As Variant, myvar As Variant
strFilePath = "C:\Users\NVanWyk\Documents\Fidato\Lunch And Learn\Lunch and Learn Access DB\Nate's Expenses DB.accdb" 'Replace the ‘DatabaseFolder’ and ‘myDB.accdb’ with your DB path and DB name
Set cnn = New ADODB.Connection
Set rs = New ADODB.Recordset
box = InputBox("What month do you want expense data for? Please use the MM/DD/YYYY format.", "Expense Month?")
If Not IsDate(box) Then
MsgBox "Value entered is not a valid date, please try again.", , "Input Value is Not Correct"
End
End If
myvar = box
cnn.Open "provider = microsoft.ace.oledb.12.0;" & _
"Data Source=" & strFilePath & ";"
'have to indent the data source or the code does not run
sQRY = "SELECT * FROM Expenses Where Expenses.Expense_Month= #" & myvar & "#" 'Replace ‘tblData’ with your Access DB Table name or Query name from which you want to download the data"
' access query
' # before and after the "myvar" variable are necessary for access to recognize the variable as a date and to run the query successfully.
rs.CursorLocation = adUseClient
rs.Open sQRY, cnn, adOpenStatic, adLockReadOnly
Application.ScreenUpdating = False
Sheet1.Range("A2").CopyFromRecordset rs
'sheet 1 for whatever reason still pastes to the "expense" sheet
rs.Close
Set rs = Nothing
cnn.Close
Set cnn = Nothing
Exit Sub
End Sub
Just to give you background of my work, i have to fetch data from MS Sql on daily basis and for that every time have to go to other server to run the query. Once the query is executed, have to paste into my common drive, which takes a lot time. ~55 mins to paste 5,00,000 row & 30 fields to common or to move file. In total 2 hours for execution & movement from one location to other.
To reduce this i would need your help to use the SQL queries through excel with the below things:
If possible,
Point1: Query will be stored in the text file in the common location
Point2: Query Parameter to be populate to get
Or
Point2:Range to be defined for parameter
If not possible above,
Query will be pasted into the code and parameter to be populated based on the above mentioned suggestion.
Connection type is windows authentication, it will work based on logged in users windows name.
This code will allow you to provide variables that you use within your SQL statement and put those into cells on a spreadsheet (In this case Cred2) and return the results on a separate sheet (Sheet2).
The first portion of the code establishes a connection with the SQL server.
The column Headers will be started in Row 2 and then the data will begin populating starting on row 3. I have used this to pull well over 100,000 records at a time and this works very quickly.
Private Sub CommandButton1_Click()
Dim cn As Object
Dim rs As Object
Dim strCon As String
Dim strSQL As String
strCon = "DRIVER=SQL Server;SERVER=ServerName;DATABASE=DBName;Trusted_Connection=True"
Set cn = CreateObject("ADODB.Connection")
cn.Open strCon
' if not a trusted connection you could replace top line of strCon with
strCon = "DRIVER=SQL Server; Server=myServerAddress;Database=myDataBase;User Id=myUsername; Password=myPassword"
' set up where you are getting your variables to include in the SQL statement
stat = Sheets("Cred2").Range("c7").Value
barg = Sheets("Cred2").Range("c10").Value
worksite = Sheets("Cred2").Range("c11").Value
' Construct SQL statement
strSQL = "select * " _
& " FROM tableName A , table2 B " _
& "WHERE A.[field1] = B.[field1] " _
& " and field1 like '" & stat & "'" _
& "and field2 like '" & barg & "'" _
& "and field3 like '" & worksite & "'" _
& " order by Field? "
' Build Record Set
Set rs = CreateObject("ADODB.RECORDSET")
rs.ActiveConnection = cn
rs.Open strSQL
' Display Data
For intColIndex = 0 To rs.Fields.Count - 1
Sheet2.Range("A2").Offset(0, intColIndex).Value = rs.Fields(intColIndex).name
Next
Sheet2.Range("A3").CopyFromRecordset rs
' Close Database
rs.Close
cn.Close
Set cn = Nothing
end sub
I'm putting together an Excel front-end with an Access database behind it, so that some of my colleagues can collate data from previous projects (without having to learn to use Access themselves!)
So I have a "Data" sheet in the Excel workbook that occasionally refreshes from the database, then a "Dashboard" sheet that allows filtering of that data.
Where I'm having trouble is in closing the loop - allowing input of new data into the database. The relevant code is below:
Private Sub btnDBImport_Click()
Dim rst As ADODB.Recordset
Dim errorList As String
Dim cn As ADODB.Connection
Set cn = New ADODB.Connection
With cn
.Provider = "Microsoft.ACE.OLEDB.16.0"
.ConnectionString = "\\FileAddress\DB.accdb"
.Open
End With
Set rst = New ADODB.Recordset
rst.CursorLocation = adUseServer
rst.Open Source:="TableName", _
ActiveConnection:=cn, _
CursorType:=adOpenDynamic, _
LockType:=adLockOptimistic, _
Options:=adCmdTableDirect
If validationTest = False Then
errorList = errorList & "Data at row " & i & " was not added to the database due to missing information." & vbCrLf
Else
rst.AddNew
With rst
.Fields(1) = Value1
.Fields(2) = Value2
End With
rst.Update
End If
Next i
If errorList <> "" Then
MsgBox errorList, vbOKOnly, "Data error"
End If
rst.Close
Set rst = Nothing
cn.Close
Set cn = Nothing
End Sub
The above is everything involved in defining, opening and working on a recordset; I get an error at rst.AddNew because "cannot update, database or object is ReadOnly".
Any help appreciated.
So, with thanks to the comment from Jimmy Smith, I've got to the bottom of this, or at least fixed my immediate problem.
The table was being treated as ReadOnly both when accessed through MS Access directly and when loaded as a Recordset using VBA because there was a link to the table in the same Excel workbook.
Now that I've deleted the link to the table and instead update the records in it through code, I'm consistently getting requested levels of access to the relevant table and everything is working as intended. Time to commit to Rubberduck and show it to the userbase.
I have an access file with over 3 milion records. I would would like that excel will be able to perfrom a vlookup serach in the access table and give me the result on excel. Any simple way to do that?
Thank's!
That would be a terribly inefficient way to do it.
In a database you can use queries with JOINs to do this. If you tell us, what the table looks like and what you want to achieve, we can give you more info.
As Andre451 said - you need SQL rather than Excel functions to get data out of the database.
This code will dump the query results into the immediate window. It should show you how to extract data from Access though.
Note - I usually make the oDB variable global if I'm planning on querying the database a lot. Also without knowing the name of your database or table structure I've just shown an example of the query used - you'll have to add code to get the employee number and year from the user.
Tip - Write your query in Access using the query editor, view it as SQL and then copy to Excel.
Sub ReturnValues()
Dim oDB As Object
Dim rst As Object
Set oDB = GetDatabaseReference
Set rst = CreateObject("ADODB.RecordSet")
With rst
.CursorType = 2
.Open "SELECT Salary FROM tbl_SomeTable WHERE Emp=1 AND Year=2015", oDB
If Not rst Is Nothing Then
If Not .BOF And Not .EOF Then
.MoveFirst
Do
Debug.Print rst.Fields("Salary")
.MoveNext
Loop While Not .EOF
End If
End If
End With
End Sub
Public Function GetDatabaseReference() As Object
Dim cn As Object
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'Only set a reference to the database if it doesn't already exist. '
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
If oDB Is Nothing Then
Set cn = CreateObject("ADODB.Connection")
Select Case Val(Application.Version)
Case 11
'Access 2003
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source =C:<Full Path To Database>.mdb;"
'Could use:
'"Data Source=" & ThisWorkbook.Path & "\Database\Database.mdb"
Case 14
'Access 2010
cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source =C:<Full Path To Database>.mdb;" & _
"Persist Security Info=False;"
''Could use:
'"Data Source=" & ThisWorkbook.Path & "\Database\Database.mdb;" & _
'"Persist Security Info=False;"
End Select
If Not cn Is Nothing Then
Set GetDatabaseReference = cn
End If
Else
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'oDB already has a reference, so ensure it's maintained. '
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Set GetDatabaseReference = oDB
End If
End Function
My previous Title caused a bit of confusion there...updated
I've encountered this problem recently while using some VBA to bridge Excel and Access.
So I have a spreadsheet containing a table that I need to import to an Access database.
The table is something generic like the following.
EmployeeNumber Unused_Field2 Unused_Field3
1 ### ###
2 ### ###
3 ### ###
The unique key in Access is set to be the EmployeeNumber.
My VBA Code in Excel looks like the following:
Sub test()
Dim con As ADODB.Connection
Dim rst As ADODB.Recordset
strcon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=c:\temp\mydb.mdb;"
strsql = "SELECT * FROM Table1"
Set con = New Connection
Set rst = New Recordset
con.Open strcon
rst.Open strsql, strcon, adOpenStatic, adLockOptimistic
For i = 0 To n
On Error GoTo Errhdl
rst.AddNew Array("Field1", "Field2", "Field3"), Array(Range("A" & i), Range("B" & i), Range("C" & i))
On Error GoTo 0
Next
Exit Sub
Errhdl:
Debug.Print "Record" & i & "caused an error"
Resume Next
End Sub
Unfortunately the data is not of high quality and I often would have duplicate values causing a key violation all the time.
While I though Resume Next will clear the Error allowing another "AddNew" to run, it did not.
All the subsequent entries after one key violation will return the same Error.
So my question is as follows:
Is there away to clear the Error associated with a recordset? ( For the record I've tried to get the "Error Collection" and used
the method Errors.Clear. That didn't do the trick. The Error Collection is a property specific to the ADO object - MSDN Errors Collection)
Can this be done without closing and re-opening the recordset?
Please let me know if more clarification is needed!
I would not use error handling (handling ADO errors is tricky) but use Find to check each time that the key does not already exist, before performing the insert. If the key is an indexed field (as your description suggests) then you might consider Seek which is more efficient for a large dataset. (However, Seek does not work with a client cursor -adUseClient.)
Here is a code fragment that I found that outlines the steps:
If Not .EOF Then
.MoveFirst
.Find "TPItemNbr='" & m_TPItemNbr & "'", , adSearchForward
End If
If .EOF Then
.AddNew
!TPItemVendorID = m_TPItemVendorID
!TPItemNbr = m_TPItemNbr
!TPItemEUOM = m_TPItemEUOM
!TPItemUOMFactor = m_TPItemUOMFactor
!TPItemPUOM = m_TPItemPUOM
!TPItemDescription = m_TPItemDescription
!TPItemUnitCost = m_TPItemUnitCost
!TPItemUnitLabor = m_TPItemUnitLabor
.Update
That is, perform a Find each time within the loop, if EOF (end-of-file) is true then the key isn't already in the table, so an insert can be performed.
Added in response to further information about the compound key.
I would create a Command object and use Execute. Yes, it requires creating a string, but you can trap and ignore errors for key violations.
The alternatives could be to
Run a separate SQL-statement to obtain a recordset of the list of duplicates
Loop through this storing the values in an array
Perform the AddNew each time checking the array
This seems messy to me, particular the aspect of searching the array.
Pursue the multi-find method linked in a comment.
So I found a solution if a Recordset.AddNew encounters and error.
The trick is to use CancelUpdate - MSDN
One can also use the Status property to check if the operation was successful.
a sample code would be:
Sub test()
Dim con As ADODB.Connection
Dim rst As ADODB.Recordset
strcon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=c:\temp\mydb.mdb;"
strsql = "SELECT * FROM Table1"
Set con = New Connection
Set rst = New Recordset
con.Open strcon
rst.Open strsql, strcon, adOpenStatic, adLockOptimistic
For i = 0 To n
On Error GoTo Errhdl
rst.AddNew Array("Field1", "Field2", "Field3"), Array(Range("A" & i), Range("B" & i), Range("C" & i))
On Error GoTo 0
Next
Exit Sub
Errhdl:
Debug.Print "Record" & i & "caused an error"
If rst.Status <> 0 Then
rst.CancelUpdate
End If
Resume Next
End Sub