EDIT: Changed as I have a different issue with the same code
2nd Edit: Adding additional code that seems to be casuing the issue
I have created a vba program in access that aggregates data from a number of external sources and write the results into a new table. Ideally when I run the program I want to wipe out all of the data that is currently in the table and replace it with my new data. I am currently currently deleting all of the data in the table... then writing my new data
Here is the code for reference
Function getTestFixtures(FixtureName As String) As Recordset
Dim db As Database
Set db = OpenDatabase(GetDBPath & "TestFixtures.xlsx", False, False, "Excel 12.0;HDR=Yes;")
If db Is Nothing Then
MsgBox "Can't find the file!", vbExclamation, ThisWorkbook.Name
Exit Function
End If
Set getTestFixtures = db.OpenRecordset("Select * from [" & FixtureName & "$]")
End Function
The recordset created above is modified and the output data is placed in a dictionary and passed to this function.
Sub Write_OTDC_Data(POlist As Dictionary)
Dim Rst As Recordset
DoCmd.SetWarnings False
DoCmd.runsql "Delete * from [OTDC Results]"
DoCmd.SetWarnings True
Set Rst = CurrentDb.OpenRecordset("OTDC Results")
With Rst
For Each key In POlist.Keys
.AddNew
For i = 0 To 9
.Fields(i).value = POlist(key)(i)
Next
.Update
Next
.Close
End With
End Sub
My Problem is that I get the following error if I try to change anything after running both of the above procuedures.
Running either in isolation does not generate the error.
I'm unsure whether this question is still unresolved. In case it's not, I have some suggestions for you to try, but not a lot of confidence they will cure the problem.
Try DoCmd.TransferSpreadsheet to import the sheet's data into a scratch table instead of using OpenDatabase with the workbook.
In your MsgBox, I wonder whether ThisWorkbook.Name means anything to an Access application. Aside from that, I would check whether the workbook exists, then open it (or import the sheet from it) only if the file is found.
If Len(Dir(GetDBPath & "TestFixtures.xlsx")) = 0 Then
'not found
Else
'use it
End If
Actually I'm unclear why you don't get an error from OpenDatabase if the workbook file doesn't exist. And that makes me suspicious of DoCmd.SetWarnings False Never, ever turn SetWarnings off. Doing so suppresses important information. And it is completely unnecessary. Set a DAO.Database object variable to CurrentDB(), then use this instead:
dbObjectVariable.Execute "Delete from [OTDC Results]", dbFailOnError
Add an error handler to deal with any problems dbFailOnError exposes.
Finally, this bears repeating because it's so important. NEVER turn SetWarnings off.
Related
I have a database that is linked to a few others. The db in question has some script that exports a table to an Excel ".xlsx" with a name that is linked to other databases. Basically data entry is done in one db and then the other db pulls in the information live so we have real time updating.
However, after the kill sequence completes and the new file is exported, the Excel file opens up. This causes a problem with the second db not being able to see real time updates since the new export file does not actually overwrite the previous since the previous has opened automatically. I need help telling the Excel export files not to open.
I know I should Dim the file name but I haven't :-).
Below is the code, any help is much appreciated.
Private Sub Form_Activate()
'Delete Existing File First; then create new
On Error Resume Next
Kill "\\ct13nt003\MFG\SMT_Schedule_Files\SMT Line Progress Files\SMT2Updated.xlsx"
On Error GoTo 0
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "SMT2Export", "\\ct13nt003\MFG\SMT_Schedule_Files\SMT Line Progress Files\SMT2Updated.xlsx", True
Going out on a limb here since I don't really do VBA in Access but I do a lot with Excel so try something like:
Private Sub Form_Activate()
Const xlFileName as String = "\\ct13nt003\MFG\SMT_Schedule_Files\SMT Line Progress Files\SMT2Updated.xlsx"
Const shortFileName as String = "SMT2Updated.xlsx"
Dim xlApp As Object 'Excel.Application
Dim xlWb as Object 'Excel.Workbook
'Delete Existing File First; then create new
On Error Resume Next
Kill xlFileName
On Error GoTo 0
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "SMT2Export", xlFileName, True
'Get the Excel Application
Set xlApp = GetObject(,"Excel.Application")
'Get the specific workbook
Set xlWb = xlApp.Workbooks(shortFileName)
'Close the workbook
xlWb.Close
'Quit Excel (if needed)
'xlApp.Quit
'Clean up
Set xlWb = Nothing
Set xlApp = Nothing
End Sub
Subscript Out of Range Error
Use the file's name instead of the full path with the xlApp.Workbooks method, per revision above.
There is another potential reason for this error, but this is the most likely.
Reading through your scenario, I'm stumped since I've never had that kind of problem with "Killing" a file. Maybe like another users suggested, you should turn off "On Error Resume Next", at least until you figure out why this error is happening.
Another suggestion would be to try a different deletion method, like
myFSO.DeleteFile "\\ct13nt003\MFG\SMT_Schedule_Files\SMT Line Progress Files\SMT2Updated.xlsx"
That code has On Error Resume Next just before Kill xlFileName. That means if the Kill fails for any reason, it will fail silently.
I have no idea whether that issue contributes to your problem, but suggest you try it this way instead.
'Delete Existing File First; then create new
'On Error Resume Next
If Len(Dir(xlFileName)) > 0 Then
Kill xlFileName
Else
' xlFileName does not exist; no Kill required
End If
'On Error GoTo 0
I'm having a bit of trouble with some vba script i'm attempting to run from a button on a form.
Via a linked MDB file, I've written a string of Make Table queries that help certain other queries work. Rather than have the user re-run each individual Make Table query one-by-one, I've put the queries in a VBA script (using DoCmd.RunSQL) and then assigned that script to a button on a form.
The data source i'm using also has a File Info table that contains the File Name and the File Date of the data.
When the user clicks the button, I'd like them to know what data source was used when the string of Make Tables queries was run; that way they know what data the script was run on.
My approach to this was to create a final Make Table query using the File Info table to put the File Name and File Date in it's own table.
I would then add these fields to the form and add the DoCmd.RunSQL for this final Make Table query in to the bottom of the VBA script for the button; once all the Make Tables had run, the File Info and File Date fields would then be displayed/updated on the form telling the user what data file had been used the last time the script was run.
Here's the code for this (for brevity I've summarised all the Make Table scripts that run prior to the FileInfo as some bogus "AllOtherMakeTables" string)
Private Sub Command0_Click()
On Error GoTo Err_Command0_Click
DoCmd.SetWarnings False
Dim AllOtherMakeTables As String
Dim FileInfoStamp As String
AllOtherMakeTables = " SELECT SomeField INTO AnotherTable" _
& " FROM SomeTable" _
FileInfoStamp = " SELECT FileInfo.FileName, FileInfo.FileDate INTO FileInfoStamp" _
& " FROM FileInfo;" _
DoCmd.RunSQL AllOtherMakeTables
DoCmd.RunSQL FileInfoStamp
DoCmd.SetWarnings True
Exit_Command0_Click:
Exit Sub
Err_Command0_Click:
MsgBox Err.Description
Resume Exit_Command0_Click
End Sub
Clicking the button using the script above yields the following error message:
The database engine could not lock table 'FileInfoStamp' because it is
already in use by another person or process
I think what is happening is the fields I added to the form (FileName and FileDate) are locking the FileInfoStamp table when the form is open, so when the script tries to recreate the FileInfoStamp it is unable to do this as the table is locked.
I thought this might be fixed simply by adding a DoCmd.Close at the start of the above script and then adding a DoCmd.OpenForm at the end of the script (essentially closing the form whilst the Make Table commands are run and then re-opening the form at the end).
All this does though is close the form and bring up the same error message. So I guess even though the form is "closed" the connections with the fields on the form still remain active in some way(...?)
Any assistance on how I might get around this would be much appreciated. Thank you.
Do not recreate FileInfoStamp each time. Use these two steps instead:
discard existing rows
append the new data
Dim db As DAO.database
Dim FileInfoStamp As String
FileInfoStamp = "INSERT INTO FileInfoStamp(FileName, FileDate)" & vbCrLf & _
"SELECT fi.FileName, fi.FileDate FROM FileInfo AS fi;"
Debug.Print FileInfoStamp
Set db = CurrentDb
' empty out FileInfoStamp
db.Execute "DELETE FROM FileInfoStamp;", dbFailOnError
' add new data to FileInfoStamp
db.Execute FileInfoStamp, dbFailOnError
Set db = Nothing
Add an error handler to deal with any problems turned up from dbFailOnError.
Instead of DoCmd.RunSQL, use the DAO database .Execute method for your other queries. With that approach, you will not have any motivation to use DoCmd.SetWarnings False. Turning SetWarnings off is unwise because it suppresses information you need to diagnose problems.
I have a very complex process that involves downloading a number of files from different shares, concatenating those files into working tables, manipulating and calculating related information, and then exporting specific fields (and calculations) as reports into a number of Excel workbooks.
I have this process coded so that I can click one button and the entire process will execute end to end. I have a series of text boxes that function as 'indicators' (red - this part failed, green - this part succeeded). As you can imagine, the code for the entire process is HUGE (32 pages when copied into MSWord) and difficult to weed through when I have a problem.
I got it into my mind that I wanted to put the code into a table so that it was much more modular and easier to deal with. I have setup a combo box with the action that I want to take and a second combo box with the report/file/object that I want to work with (ie Delete - Table 2, Acquire - File 1, Export - Report 4). I have been successful at creating the SQL statement to do simple things like del * from tbl_test and execute that from the combo boxes without any issue.
What I need to know is if there is a way to put what is essentially a code snippet into the table (memo field) and then have that vba code execute when I select the matching combos.
IE the code for 'Acquire - File1' is completely VBA code; it maps a network drive, locates the file, downloads the file, and moves it to a directory.
IE the code for 'Scrub - tblMain_Part1' is a combination of vba and sql code; it checks for the existence of a file (vba), if it finds it, it deletes a portion of the main table (sql) and appends the contents of the file it finds (sql), then it updates the monitor to indicate that it is completed (vba). If the file is not found, it changes the monitor box to red and updates a command button caption (vba)
I am NOT a genius with vba, but I hold my own. The thought process I had was that if I can essentially get the code broken into managable chunks in the table, I could call the code smippets in order if I want to run the entire process, or I could just re-execute portions of the code as needed by selecting the action and report/file/object combination.
Any thoughts/ideas are appreciated.
I think it would be best to split the code into Subs. The table you loop through would have a Sub-Name field and a blnSuccess field. Your code would loop though the table running each sub and then updating blnSuccess based on any errors you receive. This would give you queryable result set when you try to see what happened.
Consider using macros. You shouldn't need a table. Also, consider moving your hard-coded SQL to queries.
I think that you shouldn't use a table, just create a module with different subs for each operation. On your button event, after the combo selections, I would do a case statement.
dim strOperation as string
strOperation = me!selectionOne
Select Case strOperation
Case "delete": deleteTable(me!selectionTwo)
Case "export": export(me!selectionTwo)
case "acquire": acquire(me!selectionTwo)
End Select
Of course, you'd have your acquire, delete, and export methods written in a module and have whatever parameters you need for each operation there.
This is just one idea of many that you could use to approach this.
I was going to edit the original answer but this seems to be off on a different tack....
I think it would be best to split the code into functions that return a string if there is an error. The table you loop through would have a strFunction,strError and strObject fields. Your code would loop though the table running each function based on the case statement while passing the strObject as a string and then updating strError based on any errors you receive. You could query the table after this process to see which records have errors in them.
If the button is called cmdRunAll here is the code for it.
Private Sub cmdRunAll_Click()
On Error GoTo ErrHandler
Dim rst As DAO.Recordset
Set rst = CurrentDb.OpenRecordset("tblCode", dbOpenDynaset, dbSeeChanges)
If Not rst.EOF Then
With rst
.MoveFirst
Do While Not .EOF
.Edit
Select Case !strFunction
Case "fExport"
!strError = fExport(!strObject)
End Select
.Update
.MoveNext
Loop
End With
End If
rst.Close
Set rst = Nothing
MsgBox "Processes complete"
Exit Sub
ErrHandler:
Debug.Print Err.Description & " cmdRunAll_Click " & Me.Name
Resume Next
End Sub
Here is a simple sample function
Public Function fExport(strTable As String) As String
On Error GoTo ErrHandler
Dim strError As String
strError = ""
DoCmd.TransferText acExportDelim, , strTable, "C:\users\IusedMyUserNameHere\" & strTable & ".txt"
fExport = strError
Exit Function
ErrHandler:
strError = Err.Description
Resume Next
End Function
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