From MS Access I am generating several MS Access Workbooks. Via the following code I am getting the desired save location for all of the workbooks. The following code was working without issues a few days ago. Now it abruptly fails with no error number. MS Access crashes and I get a prompt to restart MS Access and a backup file is automatically created of the MS Access project I am working on.
Strangely the code works fine if I step through it with the debugger. It simply is not working at full speed.
UPDATE 1:
If I do the falling the save_location call works.
Private Sub make_report()
' TODO#: Change to late binding when working
Dim strSaveLocation as string
Dim xl as Excel.Application
dim wb as Excel.Workbook
strSaveLocation = save_location("G:\Group2\Dev\z_report")
Set xl=New Excel.Application
' do workbook stuff
With xl
strSaveLocation = strSaveLocation & "\report_name.xlsx"
wb.SaveAs strSavelLocation, xlOpenXMLWorkbook
End With ' xl
Set xl=nothing
End Sub
If I call the save_location function like this it abruptly crashes MS Access. It doesn't throw an error or anything. It just crashes.
Private Sub make_report()
' TODO#: Change to late binding when working
Dim strSaveLocation as string
Dim xl as Excel.Application
dim wb as Excel.Workbook
Set xl=New Excel.Application
' do workbook stuff
With xl
' the call to save_location is inside of the xl procedure
strSaveLocation = save_location("G:\Group2\Dev\z_report")
strSaveLocation = strSaveLocation & "\report_name.xlsx"
wb.SaveAs strSavelLocation, xlOpenXMLWorkbook
End With ' xl
Set xl=nothing
End Sub
By moving the save_location call inside the Excel.Application work string it fails. I don't understand why.
Private Function save_location(Optional ByVal initialDir As String) As String
On Error GoTo err_trap
Dim fDialog As Object
Dim blMatchIniDir As Boolean
Set fDialog = Application.FileDialog(4) ' msoFileDialogFolderPicker
With fDialog
.Title = "Select Save Location"
If NOT (initialDir=vbnullstring) then
.InitialFileName = initialDir
End If
If .Show = -1 Then
' item selected
save_location = .SelectedItems(1)
End If
End With
Set fDialog = Nothing
exit_function:
Exit Function
err_trap:
Select Case Err.Number
Case Else
Debug.Print Err.Number, Err.Description
Stop
Resume
End Select
End Function
Actions tried:
Decompile project and recompile
Create new MS Access project and import all objects
Compact and repair
Reset all reference
Notes:
I am using the client's system and
I don't know of any system updates
Client's system is a virtual desktop via VMWare
Office 2013
Windows 7 Pro
while i am not sure if this is the specific problem - but if it is the case, it messes with anything VBA. Check the folder names and file names for any apostrophes. While windows allows this, an apostrophe will be seen in VBA as a comment, and will crash it. Have the client walk you through the exact file that he selects to confirm there is no apostrophe character in the filename or folder name.
I have a form with a text box named Contract_Applying_for which is disabled on form load, but I want to have a button which allows me to edit the contents of the text box.
When I add a button I get presented with the Command Button Wizard, so I have created a Macro called ToggleEnableButton which has the instruction to
RunCode Function Name "=ToggleEnableButton()"
Then I have written the function
Function ToggleEnableButton()
If Me.Contract_Applying_for.Enabled = True Then
Me.Contract_Applying_for.Enabled = False
Else
Me.Contract_Applying_for.Enabled = True
End If
End Function
This seems to produce the error "Member already exists in an object module from which this object module derives."
The code for the ToggleEnableButton_Click is automatically created by the Command Button Wizard and is
Private Sub ToggleEnableButton_Click()
On Error GoTo Err_ToggleEnableButton_Click
Dim stDocName As String
stDocName = "ToggleEnableMacro"
DoCmd.RunMacro stDocName
Exit_ToggleEnableButton_Click:
Exit Sub
Err_ToggleEnableButton_Click:
MsgBox Err.Description
Resume Exit_ToggleEnableButton_Click
End Sub
Any suggestion of what I am doing wrong or a better way to approach this.
Seems like a very simple thing that I am trying to do, but quite a long winded approach.
As suggested by Peekay in the comments I have tried to use a checkbox instead, I wrote
Private Sub chbToggleEdit_Click()
If Me.chbToggleEdit.Value = False Then
Me.Contract_Applying_for.Enabled = False
Else
Me.Contract_Applying_for.Enabled = True
End If
End Sub
This gives the error: "A problem occurred while Microsoft Access was communication with the OLE server or ActiveX Control."
Can you not simply have:
Private Sub ToggleEnableButton_Click()
On Error GoTo Err_ToggleEnableButton_Click
ToggleEnableButton()
Exit_ToggleEnableButton_Click:
Exit Sub
Err_ToggleEnableButton_Click:
MsgBox Err.Description
Resume Exit_ToggleEnableButton_Click
End Sub
You can declare your function with the code behind your form.
Let me know if that works,
Ash
I am having trouble with committing a transaction (using Access 2003 DAO). It's acting as if I never had called BeginTrans -- I get error 3034 on CommitTrans, "You tried to commit or rollback a transaction without first beginning a transaction"; and the changes are written to the database (presumably because they were never wrapped in a transaction). However, BeginTrans is run, if you step through it.
I am running it within the Access environment using the DBEngine(0) workspace.
The tables I'm adding records to are all opened via a Jet database connection (to the same database) and using DAO.Recordset.AddNew / Update.
The connection is opened before starting BeforeTrans.
I'm not doing anything weird in the middle of the transaction like closing/opening connections or multiple workspaces etc.
There are two nested transaction levels. Basically it's wrapping multiple inserts in an outer transaction, so if any fail they all fail. The inner transactions run without errors, it's the outer transaction that doesn't work.
Here are a few things I've looked into and ruled out:
The transaction is spread across several methods and BeginTrans and CommitTrans (and Rollback) are all in different places. But when I tried a simple test of running a transaction this way, it doesn't seem like this should matter.
I thought maybe the database connection gets closed when it goes out of local scope, even though I have another 'global' reference to it (I'm never sure what DAO does with dbase connections to be honest). But this seems not to be the case -- right before the commit, the connection and its recordsets are alive (I can check their properties, EOF = False, etc.)
My CommitTrans and Rollback are done within event callbacks. (Very basically: a parser program is throwing an 'onLoad' event at the end of parsing, which I am handling by either committing or rolling back the inserts I made during processing, depending on if any errors occurred.) However, again, trying a simple test, it doesn't seem like this should matter.
Any ideas why this isn't working for me?
Thanks.
EDIT 25 May
Here is the (simplified) code. The key points having to do with the transaction are:
The workspace is DBEngine(0), referenced within the public (global) variable APPSESSION.
The database connection is opened in LoadProcess.cache below, see the line Set db = APPSESSION.connectionTo(dbname_).
BeginTrans is called in LoadProcess.cache.
CommitTrans is called in the process__onLoad callback.
Rollback is called in the process__onInvalid callback.
Recordset updates are done in process__onLoadRow, logLoadInit, and logLoad
Eric
'-------------------
'Application globals
'-------------------
Public APPSESSION As DAOSession
'------------------
' Class LoadProcess
'------------------
Private WithEvents process_ As EventedParser
Private errs_ As New Collection
Private dbname_ As String
Private rawtable_ As String
Private logtable_ As String
Private isInTrans_ As Integer
Private raw_ As DAO.Recordset
Private log_ As DAO.Recordset
Private logid_ As Variant
Public Sub run
'--- pre-load
cache
resetOnRun ' resets load state variables per run, omitted here
logLoadInit
Set process_ = New EventedParser
'--- load
process_.Load
End Sub
' raised once per load() if any row invalid
Public Sub process__onInvalid(filename As String)
If isInTrans_ Then APPSESSION.Workspace.Rollback
End Sub
' raised once per load() if all rows valid, after load
Public Sub process__onLoad(filename As String)
If errs_.Count > 0 Then
logLoadFail filename, errs_
Else
logLoadOK filename
End If
If isInTrans_ Then APPSESSION.Workspace.CommitTrans
End Sub
' raised once per valid row
' append data to raw_ recordset
Public Sub process__onLoadRow(row As Dictionary)
On Error GoTo Err_
If raw_ Is Nothing Then GoTo Exit_
DAOext.appendFromHash raw_, row, , APPSESSION.Workspace
Exit_:
Exit Sub
Err_:
' runtime error handling done here, code omitted
Resume Exit_
End Sub
Private Sub cache()
Dim db As DAO.Database
' TODO raise error
If Len(dbname_) = 0 Then GoTo Exit_
Set db = APPSESSION.connectionTo(dbname_)
' TODO raise error
If db Is Nothing Then GoTo Exit_
Set raw_ = db.OpenRecordset(rawtable_), dbOpenDynaset)
Set log_ = db.OpenRecordset(logtable_), dbOpenDynaset)
APPSESSION.Workspace.BeginTrans
isInTrans_ = True
Exit_:
Set db = Nothing
End Sub
' Append initial record to log table
Private Sub logLoadInit()
Dim info As New Dictionary
On Error GoTo Err_
' TODO raise error?
If log_ Is Nothing Then GoTo Exit_
With info
.add "loadTime", Now
.add "loadBy", CurrentUser
End With
logid_ = DAOext.appendFromHash(log_, info, , APPSESSION.Workspace)
Exit_:
Exit Sub
Err_:
' runtime error handling done here, code omitted
Resume Exit_
End Sub
Private Sub logLoadOK(filename As String)
logLoad logid_, True, filename, New Collection
End Sub
Private Sub logLoadFail(filename As String, _
errs As Collection)
logLoad logid_, False, filename, errs
End Sub
' Update log table record added in logLoadInit
Private Sub logLoad(logID As Variant, _
isloaded As Boolean, _
filename As String, _
errs As Collection)
Dim info As New Dictionary
Dim er As Variant, strErrs As String
Dim ks As Variant, k As Variant
On Error GoTo Err_
' TODO raise error?
If log_ Is Nothing Then GoTo Exit_
If IsNull(logID) Then GoTo Exit_
For Each er In errs
strErrs = strErrs & IIf(Len(strErrs) = 0, "", vbCrLf) & CStr(er)
Next Er
With info
.add "loadTime", Now
.add "loadBy", CurrentUser
.add "loadRecs", nrecs
.add "loadSuccess", isloaded
.add "loadErrs", strErrs
.add "origPath", filename
End With
log_.Requery
log_.FindFirst "[logID]=" & Nz(logID)
If log_.NoMatch Then
'TODO raise error
Else
log_.Edit
ks = info.Keys
For Each k In ks
log_.Fields(k).Value = info(k)
Next k
log_.Update
End If
Exit_:
Exit Sub
Err_:
' runtime error handling done here, code omitted
Resume Exit_
End Sub
'-------------
' Class DAOExt
'-------------
' append to recordset from Dictionary, return autonumber id of new record
Public Function appendFromHash(rst As DAO.Recordset, _
rec As Dictionary, _
Optional map As Dictionary, _
Optional wrk As DAO.workspace) As Long
Dim flds() As Variant, vals() As Variant, ifld As Long, k As Variant
Dim f As DAO.Field, rst_id As DAO.Recordset
Dim isInTrans As Boolean, isPersistWrk As Boolean
On Error GoTo Err_
' set up map (code omitted here)
For Each k In rec.Keys
If Not map.Exists(CStr(k)) Then _
Err.Raise 3265, "appendFromHash", "No field mapping found for [" & CStr(k) & "]"
flds(ifld) = map(CStr(k))
vals(ifld) = rec(CStr(k))
ifld = ifld + 1
Next k
If wrk Is Nothing Then
isPersistWrk = False
Set wrk = DBEngine(0)
End If
wrk.BeginTrans
isInTrans = True
rst.AddNew
With rst
For ifld = 0 To UBound(flds)
.Fields(flds(ifld)).Value = vals(ifld)
Next ifld
End With
rst.Update
Set rst_id = wrk(0).OpenRecordset("SELECT ##Identity", DAO.dbOpenForwardOnly, DAO.dbReadOnly)
appendFromHash = rst_id.Fields(0).Value
wrk.CommitTrans
isInTrans = False
Exit_:
On Error GoTo 0
If isInTrans And Not wrk Is Nothing Then wrk.Rollback
If Not isPersistWrk Then Set wrk = Nothing
Exit Function
Err_:
' runtime error handling, code omitted here
Resume Exit_
End Function
'-----------------
' Class DAOSession (the part that deals with the workspace and dbase connections)
'-----------------
Private wrk_ As DAO.workspace
Private connects_ As New Dictionary
Private dbs_ As New Dictionary
Public Property Get workspace() As DAO.workspace
If wrk_ Is Nothing Then
If DBEngine.Workspaces.Count > 0 Then
Set wrk_ = DBEngine(0)
End If
End If
Set workspace = wrk_
End Property
Public Property Get connectionTo(dbname As String) As DAO.database
connectTo dbname
Set connectionTo = connects_(dbname)
End Property
Public Sub connectTo(dbname As String)
Dim Cancel As Integer
Dim cnn As DAO.database
Dim opts As Dictionary
Cancel = False
' if already connected, use cached reference
If connects_.Exists(dbname) Then GoTo Exit_
If wrk_ Is Nothing Then _
Set wrk_ = DBEngine(0)
' note opts is a dictionary of connection options, code omitted here
Set cnn = wrk_.OpenDatabase(dbs_(dbname), _
CInt(opts("DAO.OPTIONS")), _
CBool(opts("DAO.READONLY")), _
CStr(opts("DAO.CONNECT")))
' Cache reference to dbase connection
connects_.Add dbname, cnn
Exit_:
Set cnn = Nothing
Exit Sub
End Sub
Transactions are used by defining a workspace (it doesn't have to be a new one) and then beginning the transaction on that workspace, doing what you need to do with it, and then commiting the transaction if all is well. Skeletal code:
On Error GoTo errHandler
Dim wrk As DAO.Workspace
Set wrk = DBEngine(0) ' use default workspace
wrk.BeginTrans
[do whatever]
If [conditions are met] Then
wrk.CommitTrans
Else
wrk.Rollback
End If
errHandler:
Set wrk = Nothing
exitRoutine:
' do whatever you're going to do with errors
wrk.Rollback
Resume errHandler
Now, within the block where you [do whatever], you can pass off the workspace and databases and recordsets to subroutines, but the top-level control structure should remain in one place.
Your code does not do that -- instead, you depend on global variables. GLOBAL VARIABLES ARE EVIL. Don't use them. Instead, pass private variables as parameters to the subroutines you want to operate on them. I would also say, never pass the workspace -- only pass the objects you've created with the workspace.
Once you've absorbed that, maybe it will help you explain what your code is supposed to accomplish (which I haven't the foggiest idea of from reading through it), and then we can advise you as to what you're doing wrong.
OK, after much frustrating debugging, I think I uncovered a bug in Jet transactions. After all that, it has nothing to do with my "enormously convoluted" code or "evil global variables" :)
It appears that when the following is true, you get the error #3034:
You open a snapshot-type recordset
The recordset is opened before you start the transaction
The recordset is closed/dereferenced after you begin the transaction, but before the commit or rollback.
I haven't checked if this is already known, although I can't imagine it isn't.
Of course, it's kind of weird to do things in this order anyway and asking for trouble, I don't know why I did it. I moved opening/closing the snapshot recordset to within the transaction and everything works fine.
The following code exhibits the error:
Public Sub run()
Dim db As DAO.Database, qdf As DAO.QueryDef, rst As DAO.Recordset
Dim wrk As DAO.Workspace, isInTrans As Boolean
On Error GoTo Err_
Set wrk = DBEngine(0)
Set db = wrk(0)
Set rst = db.OpenRecordset("Table2", DAO.dbOpenSnapshot)
wrk.BeginTrans
isInTrans = True
Set qdf = db.CreateQueryDef("", "INSERT INTO [Table1] (Field1, Field2) VALUES (""Blow"", ""Laugh"");")
qdf.Execute dbFailOnError
Exit_:
Set rst = Nothing
Set qdf = Nothing
Set db = Nothing
If isInTrans Then wrk.CommitTrans
isInTrans = False
Exit Sub
Err_:
MsgBox Err.Description
If isInTrans Then wrk.Rollback
isInTrans = False
Resume Exit_
End Sub
And this fixes the error:
Public Sub run()
Dim db As DAO.Database, qdf As DAO.QueryDef, rst As DAO.Recordset
Dim wrk As DAO.Workspace, isInTrans As Boolean
On Error GoTo Err_
Set wrk = DBEngine(0)
Set db = wrk(0)
wrk.BeginTrans
isInTrans = True
' NOTE THIS LINE MOVED WITHIN THE TRANSACTION
Set rst = db.OpenRecordset("Table2", DAO.dbOpenSnapshot)
Set qdf = db.CreateQueryDef("", "INSERT INTO [Table1] (Field1, Field2) VALUES (""Blow"", ""Laugh"");")
qdf.Execute dbFailOnError
Exit_:
Set rst = Nothing
Set qdf = Nothing
Set db = Nothing
If isInTrans Then wrk.CommitTrans
isInTrans = False
Exit Sub
Err_:
MsgBox Err.Description
If isInTrans Then wrk.Rollback
isInTrans = False
Resume Exit_
End Sub
For what it is worth this seems to be a bit more widespread than just Access transactions. I have just encountered a similar situation using Access 2007 & DAO as a front end to MySQL. With MySQL Autocommit=0, The SQL transactions would nonetheless mysteriously commit themselves half way through a transaction.
After 2 weeks of head scratching I came across this post and looked at my code again. Sure enough, the MySQL inserts were being done by a Stored procedure that was called from within a VBA class module. This class module had a dao.recordset that was opened on module.initialize() and closed on terminate(). Furthermore, this recordset was used to collect the results of the stored procedure. So I had (in pseudo code...)
module.initialize - rs.open
class properties set by external functions
transaction.begins
Mysql procedure.calls using class properties as parameters -
commit(or rollback)
rs.populate
class properties.set
properties used by external functions
module terminate - rs.close
and the transactions were just not working. I tried everything imaginable for 2 weeks.
Once I declared and closed the rs within the transaction everything worked perfectly!
I am using the following code to refresh Excel pivot tables from an Access application. What is the best way to save and close the Excel app after the pivots refresh? In my last attempt the code was trying to save and close before the pivots had refreshed.
Private Sub Command161_Click()
Dim objXL As Object, x
On Error Resume Next
Set objXL = CreateObject("Excel.Application")
With objXL.Application
.Visible = True
'Open the Workbook
.Workbooks.Open "myfilepath.xls"
'Refresh Pivots
x = .ActiveWorkbook.RefreshAll
End With
Set objXL = Nothing
End Sub
Set the pivottable.pivotcache.backgroundquery property to False for synchronous updates.
I need help coming up with a method to allow a user to export a query's results to an xls file on a button click event.
I've tried using an Output To macro, but it doesn't work for a query containing 30,000+ records.
Thanks in advance
You might want to consider using Automation to create an Excel spreadsheet and populate it on your own rather than using a macro.
Here's a function I have used in the past to do just that.
Public Function ExportToExcel(FileToCreate As String, ByRef rst As ADODB.Recordset)
'Parms: FileToCreate - Full path and file name to Excel spreadsheet to create
' rst - Populated ADO recordset to export
On Error GoTo Err_Handler
Dim objExcel As Object
Dim objBook As Object
Dim objSheet As Object
'Create a new excel workbook; use late binding to prevent issues with different versions of Excel being
'installed on dev machine vs user machine
Set objExcel = CreateObject("Excel.Application")
Set objBook = objExcel.Workbooks.Add
'Hide the workbook temporarily from the user
objExcel.Visible = False
objBook.SaveAs (FileToCreate)
'Remove Worksheets so we're left with just one in the Workbook for starters
Do Until objBook.Worksheets.Count = 1
Set objSheet = objBook.Worksheets(objBook.Worksheets.Count - 1)
objSheet.Delete
Loop
Set objSheet = objBook.Worksheets(1)
rst.MoveFirst
'Use CopyFromRecordset method as this is faster than writing data one row at a time
objSheet.Range("A1").CopyFromRecordset rst
'The UsedRange.Rows.Count property can be used to identify the last row of actual data in the spreadsheet
'This is sometimes useful if you need to add a summary row or otherwise manipulate the data
'Dim lngUsedRange As Long
'lngUsedRange = objSheet.UsedRange.Rows.Count
'Save the spreadsheet
objBook.Save
objExcel.Visible = True
ExportToExcel = True
Err_Handler:
Set objSheet = Nothing
Set objBook = Nothing
Set objExcel = Nothing
DoCmd.Hourglass False
If Err.Number <> 0 Then
Err.Raise Err.Number, Err.Source, Err.Description
End If
End Function
Can you use VBA?
Intellisense will help you, but get started with:
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "my_query_name", "C:\myfilename.xls"
Note: you may have a different Excel version
"my_query_name" is the name of your query or table
you'll need to set the file location to the appropriate location\name .extension
More Info: http://msdn.microsoft.com/en-us/library/bb214134.aspx