I have an Access database and an Excel workbook.
What I need to do is query the database and paste the query into a worksheet.
The issue is Runtime. I have stepped throught the program and everything works, but it works extremely slow, we're talking up to 30 second run times per query, although most of this run time is coming with the CopyFromRecordset call.
The database has over 800k rows in the table I'm querying.
Currently at my company there are people every morning who manually query the tables and copy and paste them into excel. I'm trying to remove this process.
Here is what I have:
Sub new1()
Dim objAdoCon As Object
Dim objRcdSet As Object
' gets query information '
Dim DataArr()
Sheets("Data2").Activate
DataArr = Range("A1:B40")
For i = 1 To UBound(DataArr)
job = DataArr(i, 1)
dest = DataArr(i, 2)
If InStr(dest, "HT") > 0 Then
OpCode = "3863"
ElseIf InStr(dest, "HIP") > 0 Then
OpCode = "35DM"
End If
strQry = "SELECT * from [BATCHNO] WHERE ([BATCHNO].[Job]='" & job & "') AND ([BATCHNO].[OperationCode] = " & "'" & OpCode & "')"
Set objAdoCon = CreateObject("ADODB.Connection")
Set objRcdSet = CreateObject("ADODB.Recordset")
objAdoCon.Open "Provider = Microsoft.Jet.oledb.4.0;Data Source = C:\Users\v-adamsje\Desktop\HTmaster.mdb"
'long run time
objRcdSet.Open strQry, objAdoCon
'very long run time
ThisWorkbook.Worksheets(dest).Range("A2").CopyFromRecordset objRcdSet
Set objAdoCon = Nothing
Set objRcdSet = Nothing
Next i
End Sub
Any help is appreciated. I am new to VBA and Access so this could be an easy fix. Thanks
Excel is very good at getting data for itself, without using VBA.
On the DATA ribbon
create a connection to a table or view of data somewhere (eg mdb or SServer)
then use the "existing connections" button to add data from your connected table to a worksheet table (ListObject).
You can even set the workbook (ie connection) to refresh the data every 12 hours.
Repeat for all the tables /view you need to grab data for. You can even specify SQL as part of the connection.
Let excel look after itself.
I just grabbed a 250,000 row table from a "nearby" disk in 2 secs.
It will look after itself and has no code to maintain!
I don't see how the CopyFromRecordset can be improved. You could copy the recods programmatically (in VB) record-by-record but that will probably be slower than the CopyFromRecordset.
You can move the CreateObject statements out of the loop, With the connection and RecordSet already created, this could be faster:
Set objAdoCon = CreateObject("ADODB.Connection")
Set objRcdSet = CreateObject("ADODB.Recordset")
For i = 1 To UBound(DataArr)
...
next i
Set objRcdSet = Nothing
Set objAdoCon = Nothing
You could also try ADO instead of DAO. ADO seems to perform faster on large record sets.
But also the server could be an issue, for example, are there indexes on Job and OperationCode? If not, then the slowness could be the server selecting the records rather than Excel placing them in the worksheet.
Whelp, never found out why the CopyFromRecordset runtime was obsurd, but solved my problem by pulling the whole table into excel then into an array, looping through that and putting them in respective sheets. From 30min runtime to <1min
Related
I have a little problem with downloading data from Oracle DB and moving it to the MySQL table.
On Oracle i have only a read privilege. The only task I could execute is Select.
On MySQL i have select/insert/update privilege. Also, there's no problem to change anything in mysql structure - i also have access to mysql root.
Each week I have to download huge amount of data from Oracle and move it to MySQL (for further processing). The best (and the only) solution in my case is to use MS Access.
My vba code snippet looks like (code is usually put into a loop, where I perform some inserts, each for different business site. Executing it in one query sometimes meet no end).
Public Sub DownloadData()
On Error GoTo ErrorTrans
DoCmd.SetWarnings False
Dim strWhere1 As String, strWhere2 As String, strQueryName As String
Dim qdDaneObrRabE As QueryDef, qdDaneObrRabTmp As QueryDef
Dim cnADO As ADODB.Connection
DoCmd.OpenQuery ("qryDaneObrRabCzysc") 'Calling truncate data procedure on mysql table
Set cnADO = CurrentProject.Connection
cnADO.CommandTimeout = 300 '5 minut
Set qdDaneObrRabE = CurrentDb.QueryDefs("qryDaneObrRabE")
strQueryName = "tmpObroty_" & GenerateHash(8)
Set qdDaneObrRabTmp = CurrentDb.CreateQueryDef(strQueryName, "select * from table2;") 'this select is just dummy statement, replaced some lines below
qdDaneObrRabTmp.Connect = qdDaneObrRabE.Connect
qdDaneObrRabTmp.SQL = Replace(qdDaneObrRabE.SQL, "{WHERE1}", strWhere1)
qdDaneObrRabTmp.SQL = Replace(qdDaneObrRabTmp.SQL, "{WHERE2}", strWhere2)
cnADO.Execute "INSERT INTO mysqltable SELECT * FROM " & strQueryName & ";"
Call QueryDefsCleanUp("tmpObroty_")
Call MsgBox("Success")
Set cnADO = Nothing
Exit Sub
ErrorTrans:
Call ActivityLog(Environ("USERNAME"), Now, "DownloadData", True, Err.Number, Err.Description)
End Sub
Please let me know if executing these types of inserts via ADODB is good.
I also tested DAO but i don't see difference.
All of used tables/querydefs are linked tables or pass-through querydefs.
Problem Background:
I have a Powershell script that I can execute from my Microsoft Access Form that scans through file folders that contain information on different facilities, and produces a CSV that looks something like:
SiteCode FacilityNumber DocumentType HyperlinkPath
DKFZ 10 DD1400 C:\FACILITIES DATABASE\path
DKFZ 10 FLRPLN C:\FACILITIES DATABASE\path
SMQL 17 P1 C:\FACILITIES DATABASE\path
SMQL 17 P2 C:\FACILITIES DATABASE\path
So that way every time new files are added to those folders, I can just run this script and produce an updated list of everything I have:
C:\...\Output\scanResults.csv
All I need now is to take that CSV file and update (or even overwrite) a Table that I have in an Access database, which has relationships to other tables and is used by various Queries and Forms in the database. The CSV columns are already named and formatted in the same way as the Access Table.
I've looked at and tried to replicate the following threads:
VBA procedure to import csv file into access
Access Data Project Importing CSV File In VBA
VBA Import CSV file
The closest answer I found is:
Sub Import()
Dim conn as new ADODB.Connection
Dim rs as new ADODB.Recordset
Dim f as ADODB.field
conn.Open "DRIVER={Microsoft Text Driver (*.txt; *.csv)};DBQ=c:\temp;"
rs.Open "SELECT * FROM [test.txt]", conn, adOpenStatic, adLockReadOnly, adCmdText
While Not rs.EOF
For Each f In rs.Fields
Debug.Print f.name & "=" & f.Value
Next
Wend
End Sub
But this obviously won't write the data into the table, and I could not understand what the author was trying to say with respect to changing Select to Insert.
I've also found:
DoCmd.TransferText acImportDelim, "YourCustomSpecificationName", _
"tblImport", "C:\SomeFolder\DataFile.csv", False
Since both of these are from 2010, I wonder if there isn't a better way to accomplish this in Access 2013. And while I can do this all manually, I would like to incorporate it into the VBA code I use to tell Powershell to produce the CSV, that way I can make it and then upload it immediately.
Any help or suggestions are greatly appreciated. I'm still very green to Access, VBA, and SQL statements in general, so this has been very much a "learning as I go" process.
I prefer to use SQL clauses and queries to import such data. The details depend on your exact configuration, but it tends to look something like this:
SELECT *
INTO MyTable
FROM [Text;FMT=CSVDelimited;HDR=No;DATABASE=C:\...\Output].[scanResults#csv]
Or append the information to the table instead:
INSERT INTO MyTable
(SiteCode, FacilityNumber, DocumentType, HyperlinkPath)
SELECT *
FROM [Text;FMT=CSVDelimited;HDR=No;DATABASE=C:\...\Output].[scanResults#csv]
This allows you to do checks before importing (using a WHERE clause), import only specific values, and allows you to customize a lot without using external files.
DATABASE= is followed by your folder name (use {} if there are characters that need escaping in there), and then followed by your file name with . replaced with #.
You can execute it by either saving it as a query, or using it as a string in either VBA or a macro. Note that I rarely recommend macro's, but you can execute them using a scheduled task and close Access after importing.
To backup and restore a relation before and after updating, you can use the following functions:
Public Function DeleteRelationsGiveBackup(strTablename As String) As Collection
Dim ReturnCollection As Collection
Set ReturnCollection = New Collection
Dim i As Integer
Dim o As Integer
Do While i <= (CurrentDb.Relations.Count - 1)
Select Case strTablename
Case Is = CurrentDb.Relations(i).Table
ReturnCollection.Add DuplicateRelation(CurrentDb.Relations(i))
o = o + 1
CurrentDb.Relations.Delete CurrentDb.Relations(i).NAME
Case Is = CurrentDb.Relations(i).ForeignTable
ReturnCollection.Add DuplicateRelation(CurrentDb.Relations(i))
o = o + 1
CurrentDb.Relations.Delete CurrentDb.Relations(i).NAME
Case Else
i = i + 1
End Select
Loop
Set DeleteRelationsGiveBackup = ReturnCollection
End Function
Public Sub RestoreRelationBackup(collRelationBackup As Collection)
Dim relBackup As Variant
If collRelationBackup.Count = 0 Then Exit Sub
For Each relBackup In collRelationBackup
CurrentDb.Relations.Append relBackup
Next relBackup
End Sub
Public Function DuplicateRelation(SourceRelation As Relation) As Relation
Set DuplicateRelation = CurrentDb.CreateRelation(SourceRelation.NAME, SourceRelation.Table, SourceRelation.ForeignTable)
DuplicateRelation.Attributes = SourceRelation.Attributes
Dim i As Integer
Dim fldLoop As Field
Do While i < SourceRelation.Fields.Count
Set fldLoop = DuplicateRelation.CreateField(SourceRelation.Fields(i).NAME)
fldLoop.ForeignName = SourceRelation.Fields(i).ForeignName
DuplicateRelation.Fields.Append fldLoop
i = i + 1
Loop
End Function
And then, when importing:
Dim colRelBackup As Collection
Set colRelBackup = DeleteRelationsGiveBackup("MyTable")
'Delete MyTable
'Import new version
RestoreRelationBackup colRelBackup
(Note that the code is quite long, developed for a project several years ago, and not extensively tested. If a field name/type is not exactly like how it was before the import, the restore of the backup might fail and the relations will be permanently lost).
So some high level architect advice: replacing data versus replacing table
It is easier replacing data - - the new incoming data must be the exact same structure as the existing table (i.e. same field names and no new fields).
just fire a Delete Query to the existing table that clears out all records
then fire an Append Query to the linked CSV file that writes all those records into the existing table
very simple really.
You can replace the tables if you must - and you are already down this path. You can delete those table relationships entirely. That table relationship feature is useful - but not mandatory. You can create relationships at the query level as an alternative. Essentially the table relationships just auto create the query level relationships. If you delete the table relationships then one must simply create the table relationships at the query level manually - they don't automatically appear. Note however that if one is relying on cascade deletes or referential integrity, then removing table relationships will undo that - so you should check these points.
Deleting Table Relationships will not break any existing queries. Their table relationship join lines will remain intact.
I'm trying to create a dynamic report in Excel. I have lots of sales data and I want the user to be able to slice and dice it according to his needs.
Normally I would use two sheets: one hidden, containing the raw data, and one visible, containing all the buttons and form controls so that the user can dinamically select and visualize only a small subset of the original data at the time.
The problem is that this time I need to handle 6.000.000+ rows of data (and counting). Storing it all in an excel sheet is not an option. Besides, the data is already in the form of an Access table.
I tried accessing it dinamically via a query that "filters out" the un-needed information based on what the user selects in the form control on the Excel sheet. For some reason, this is very slow. It takes 4-5 minutes to pull out as little as 10 rows of data.
There has to be a quicker way to do this! I need this whole process to feel "instantaneous".
Any thoughts?
Edit: Ok, so the problem seems to be related to the fact that my access table is actually a linked table pointing to a *.txt file. This slows the import down a lot.
I tried both of the suggested solutions.
iDevlop's idea works quite fast (200k rows imported in 10-15 secs), but it has the downside of me having to update the table every time. I'll post another question, like he suggested, to see how and if the process can be automated.
Remou's script works perfectly too now (I had a hard time getting it right but he was really open and helpful so know I got it) and, although slower, it has the advantage of not requiring any database mantainance.
There's a few more things I need to get straight before choosing which approach to use. For now, all I want to say is thank you guys for you help! I could have never made it without you!!!
Don't bother going through Access if you have a text file. This may hold you until you can get a better system in place.
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
strFile = "z:\docs\"
''Note that if HDR=No, F1,F2 etc are used for column names,
''if HDR=Yes, the names in the first row of the range
''can be used.
''
''Connection strings : http://www.connectionstrings.com/excel
strCon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strFile _
& ";Extended Properties=""Text;HDR=Yes;IMEX=1"";"
''Late binding, so no reference is needed
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
cn.Open strCon
strSQL = "SELECT * " _
& "FROM [test.txt] a " _
& "WHERE a.FirstName ='Bernard'"
rs.Open strSQL, cn, 3, 3
''Pick a suitable empty worksheet for the results
Worksheets("Sheet3").Cells(2, 1).CopyFromRecordset rs
''Tidy up
rs.Close
Set rs = Nothing
cn.Close
Set cn = Nothing
If your file is tab delimited, you can use a schema.ini (http://msdn.microsoft.com/en-us/library/ms709353(VS.85).aspx). It must be in the same directory as you text file and need only contain two lines:
[Ordini BO new.txt]
Format=TabDelimited
Your connection string should read:
strCon = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strFile _
& ";Extended Properties=""Text;HDR=No;IMEX=1;FMT=Delimited"";"
As says Remou, check xour indexes, but also make sure your criteria are entered in a way that allows indexes to be used !
e.g : WHERE Format(myDate,"yyyy-mm") = "2011-09" does not allow the date index optimisation,
while WHERE myDate BETWEEN #09/01/2011# AND #09/30/2011# does allow index optimisation.
Edit:
If you have some kind of unique identifier in your text file and you translate that into a PK in your table design, you can then import the whole thing on a regular basis, and the duplicates will be discarded by the PK.
The import could be automated, even with a .vbs, you don't need Access to do it. Make that another question if you're stuck.
You could also ask the IT guys to delete the older records every month or so.
I am trying to run the following code to loop around a recordset and do updates where neccessary.
I have a Microsoft Access database connected to a MySql backend. Whenever I run this code I get the following error:
3197 error: The Microsoft Office Access database engine stopped the process because you and another user are attempting to change the same data at the same time.
The code is below:
Private Sub test()
Dim rs As DAO.Recordset, rsCnt As Long, i As Long
Set rs = CurrentDb.OpenRecordset("qryMyQuery", DB_OPEN_DYNASET)
rs.MoveLast
rsCnt = rs.RecordCount
rs.MoveFirst
For i = 1 To rsCnt
rs.Edit
rs!MyFieldInTable = "test"
rs.Update
Next i
End Sub
I thought the Access database might be corrupt so I pulled an earlier backup but it's doing the same thing which makes me think it's a MySql issue.
We use an identical piece of code on another version of this database linked to a different MySql table and it works fine.
Also, when I open the query the record-set is based on I can edit the data in the query without any issues.
Just to add, on the first loop, rs!MyFieldInTable is updated, then I get the error.
It does not appear that you are moving to another record in the recordset. Simply incrementing i doesn't move to the next record. A more traditional approach would be to iterate over the recordset without the need for your other variables (i and rsCnt).
Dim rs as DAO.Recordset
Set rs = CurrentDb.OpenRecordset("qryMyQuery", DB_OPEN_DYNASET)
rs.moveFirst
Do Until rs.EOF
rs.Edit
rs!FieldNameHere = "test"
rs.Update
rs.MoveNext
Loop
EDIT
After a bit of searching I came across this thread which seems to be similar to your issue. At the bottom of the thread a suggestion is made to modify the ODBC settings for your MySQL DSN by selecting the "Advanced" tab and selecting the option to "Return Matching Rows". The post also says to drop the linked table and then re-link it to your Access database.
I haven't used Access with MySQL in the past, so I have no idea whether this will work or not, so proceed with caution!
You may also try changing your recordset to use the dbOptimistic flag for the recordset locking option to see if that helps at all:
set rs = CurrentDB.OpenRecordSet("qryMyQuery", DB_OPEN_DYNASET, dbOptimistic)
Two things you can try. First, try adding the dbSeeChanges option when opening the recordset:
Dim rs as DAO.Recordset, db As DAO.Database
Set db = Currentdb
Set rs = db.OpenRecordset("qryMyQuery", dbOpenDynaset, dbSeeChanges)
Do Until rs.EOF
rs.Edit
rs!FieldNameHere = "test"
rs.Update
rs.MoveNext
Loop
The other option, as #HansUp suggested, is to use a SQL update statement instead of a dynamic recordset. The key there is to open the recordset as a snapshot, so that changes you make to the records do not affect the recordset itself.
Dim rs as DAO.Recordset, db As DAO.Database
Set db = Currentdb
Set rs = db.OpenRecordset("qryBatchPayments", dbOpenSnapshot)
Do Until rs.EOF
db.Execute "UPDATE Payments " & _
"SET DCReference='test' " & _
"WHERE PaymentID=" & !PaymentID, dbFailOnError
rs.MoveNext
Loop
I was having the same problem and my solution turned out to be the default value for BIT(1) fields. Access does not like these to be null. Make sure you use either 0 or 1 in mysql for these fields.
I don't have MySQL here to try this against, but it looks to me as if your code is not advancing the recordset after the rs.Update method is executed, so that you are trying to udate the same field in the fierst record.
Add this line after the rs.Update:
rs.MoveNext
Hope that helps.
Try calling OpenRecordset from an object variable set to CurrentDb(), rather than directly from CurrentDb().
Dim rs as DAO.Recordset
Dim db As DAO.Database
Set db = Currentdb
Set rs = db.OpenRecordset("qryMyQuery", DB_OPEN_DYNASET)
rs.moveFirst
Do Until rs.EOF
rs.Edit
rs!FieldNameHere = "test"
rs.Update
rs.MoveNext
Loop
The reason for that suggestion is I've found operations on CurrentDb directly can throw an error about "block not set". But I don't get the error when using an object variable instead. And ISTR OpenRecordset was one such operation where this was an issue.
Also, my impression was your approach is a cumbersome way to accomplish the equivalent of:
UPDATE qryMyQuery SET FieldNameHere = "test";
However, I suspect the example is a proxy for a real world situation where the recordset approach is useful. Still that makes me wonder whether you would see the same or a different error when executing the UPDATE statement.
If you continue to have trouble with this, it may help to show us the SQL View for qryMyQuery.
I have discovered that if one tries to save data which are the same as the one already in the MySql record Access will display this kind of error. I've tried some suggestions from this thread but did not help.
The simple solution for this is to save a slightly diffrent data by using a manual time-stamp. Here is an example of heaving a sort order field and setting it to 10, 20, 30...
i = 10
timeStamp = Now()
Do Until Employee.EOF
Employee.Edit
Employee!SortOrderDefault = i
Employee!LastUpdated = timeStamp
Employee.Update
i = i + 10
Employee.MoveNext
Loop
I've tried automatic time-stamp in the MySql table but did not help when the new entry data is the same as the old one.
My little helpful hint is, bits are very, very, very bad data types to use when linking SQL tables to Microsoft Access because only SQL Server understands what a bit is, Microsoft Access has a hard time interpreting what a bit is. Change any bit datatypes to int (integers) and relink your tables that should clear things up. Also, make sure your Booleans always contain a 1 or a 0 (not a yes/no or a true/flase) in your VBA code or your updates will fail to the linked SQL tables because Microsoft Access will try to update them with a True/False or a Yes/No and SQL will not like that.
I also had same problem; i solved them adding those to code using dao.recordset:
**rst.lockedits = true**
rst.edit
rst.fields(...).value = 1 / rst!... = 1
rst.update
**rst.lockedits = false**
this seems fix conflict between just opened data (such as in a form) and updating them with code.
Sorry for my bad english... i read a lot but i never had learn it! I'm just italian.
I have a table in MS Access, which has the following data to be exported to excel
Release numbers
Test cases
Results
After exporting to Excel I want to have distinct release numbers as rows starting from A2 and distinct test case name as columns starting from B1. There might be couple thousands records. Then each cell will be set to result tag. Additionally will need some fancy coloring/bordering stuff.
The question - is it possible to do this using VBA in Access and if yes what is the way to go? Any hint, sample, example, resource would be appreciated... I've googled but the most thing I came accross is DoCmd.TransferSpreadsheet or DoCmd.OutputTo which I believe will not do what I want. Saw some examples with CreateObject("Excel.Application") but not sure what are limitations and performance using this way.
I don't know if it would work for your case, but you might try adding the VBA code to an Excel document rather than the Access database. Then you could refresh the data from the Excel file and add the formatting there much easier. Here is one example:
http://www.exceltip.com/st/Import_data_from_Access_to_Excel_%28ADO%29_using_VBA_in_Microsoft_Excel/427.html
(Or see other examples at http://www.exceltip.com/exceltips.php?view=category&ID=213)
Again, it may not work for your case, but it may be an option to consider. Essentially, instead of pushing from Access, you would pull from Excel.
Yes, there are many cases when the DoCmd.TransferSpreadsheet command is inadaquate.
The easiest way is to reference the Excel xx.x Object model within Access (Early Binding). Create and test your vba export function that way. Then once you are satisfied with your output, remove the Excel object model reference, then change your objects to use use Late Binding using CreateObject. This allows you to easily have other machines that are using different versions of Excel/Access to use it just the same.
Here is a quick example:
Sub ExportRecordsetToExcel(outputPath As String, rs As ADODB.Recordset)
'exports the past due report in correct formattig to the specified path
On Error GoTo handler:
Const xlUP As Long = -4162 'excel constants if used need to be referenced manually!
Dim oExcel As Object
Dim oBook As Object
Dim oSheet As Object
Dim row As Long
If rs.BOF And rs.EOF Then
Exit Sub 'no data to write
Else
rs.MoveFirst
End If
row = 1
Set oExcel = CreateObject("Excel.Application")
oExcel.Visible = False 'toggle for debugging
Set oBook = oExcel.Workbooks.Add 'default workbook has 3 sheets
'Add data to cells of the first worksheet in the new workbook.
Set oSheet = oBook.worksheets(1)
Do While rs.EOF = False
oSheet.range("A" & row).value = rs.Fields("MyField").value
'increase row
row = row + 1
Loop
oBook.SaveAs (outputPath)
'tidy up, dont leave open excel process
Set oSheet = Nothing
Set oBook = Nothing
oExcel.Quit
Set oExcel = Nothing
Exit Sub
handler:
'clean up all objects to not leave hanging processes
End Sub