Access VBA runs and stop suddenly

[acesQuer]

Hi all,

I am doing running some queries in ms access and output the results to ms excel spreadsheet. There are several subroutines that I run when I click on a button on the form in ms access to trigger the process.

Occassionally, when I run my the routines, ms access runs for some and left out the rest. Eg: I run a total of 8 routines in a button. Access would run 5 out of the 8 routines and hangs there.

Any reason for the bizzare behaviour?

I have attached the following codes that I used for reference.

(This is the first routine I run to open the spreadsheet)

Sub exportOBVolAgeingDataFirst(sDate As Date, rng As String, stat As String, ag As String)
Dim adoConn As ADODB.Connection
Dim adors As ADODB.Recordset
Dim sql As String

sql = "TRANSFORM sum(vol)" _
& " SELECT AgeGroup" _
& " FROM popGroup" _
& " WHERE (weekDate Between (" & "#" & (sDate) & "#" & ") And Format(Date(),'m/dd/yyyy') AND AgeGroup= " & "'" & ag & "'" & " )" _
& " GROUP BY AgeGroup" _
& "PIVOT DateAdd('ww',DateDiff('ww',0,weekDate),0)-1"

filename = "\\pgfiles\_test$\Desktop\db1.mdb"

Call getConn(adoConn, adors, sql, filename, "", "")


Dim ExcelApp As Object
Dim ExcelSht As Excel.Worksheet
Dim ExcelWkb As Excel.Workbook
Dim counter As Integer
Dim tempPointer As Integer

On Error Resume Next
Set ExcelApp = CreateObject("Excel.Application")

DoCmd.SetWarnings False
ExcelApp.Application.DisplayAlerts = False
ExcelApp.Application.ScreenUpdating = False
ExcelApp.Visible = True
'Set ExcelWkb = ActiveWorkbook
Set ExcelWkb = ExcelApp.Workbooks.Open("\\pgfiles\_test$\Desktop\Dashboard.xls", False, False)


With ExcelWkb
.Sheets("popSht").Select

With .ActiveSheet


'tempPointer = 4

.Range(rng).CopyFromRecordset adors
'MsgBox adors.Fields.Count
'--------Header Data-----------------
For counter = 1 To adors.Fields.Count
.Cells(2, counter) = adors.Fields(counter - 1).Name
'tempPointer = tempPointer + 1
Next
'------------------------------------

End With

End With
ExcelApp.Application.ScreenUpdating = True

'ExcelSht.Range("A1").CopyFromRecordset adors


adors.Close
adoConn.Close
Set adors = Nothing
Set adoConn = Nothing

Set ExcelSht = Nothing

Set ExcelWkb = Nothing
Set ExcelApp = Nothing
'ExcelApp.Quit

End Sub

(This is the second routine I run to run on the spreadsheet as activesheet)

Sub exportOBVolAgeingDataSecond(sDate As Date, rng As String, stat As String, ag As String)
Dim adoConn As ADODB.Connection
Dim adors As ADODB.Recordset
Dim sql As String

sql = "TRANSFORM sum(vol)" _
& " SELECT AgeGroup" _
& " FROM popGroup" _
& " WHERE (weekDate Between (" & "#" & (sDate) & "#" & ") And Format(Date(),'m/dd/yyyy') AND AgeGroup= " & "'" & ag & "'" & " )" _
& " GROUP BY AgeGroup" _
& "PIVOT DateAdd('ww',DateDiff('ww',0,weekDate),0)-1"

filename = "\\pgfiles\_test$\Desktop\db1.mdb"

Call getConn(adoConn, adors, sql, filename, "", "")


Dim ExcelApp As Object
Dim ExcelSht As Excel.Worksheet
Dim ExcelWkb As Excel.Workbook
Dim counter As Integer
Dim tempPointer As Integer

On Error Resume Next
Set ExcelApp = GetObject(, Excel.Application)
'DoCmd.SetWarnings False
'ExcelApp.Application.DisplayAlerts = False
ExcelApp.Application.ScreenUpdating = False
'ExcelApp.Visible = True
Set ExcelWkb = ActiveWorkbook


With ExcelWkb
.Sheets("popSht").Select

With .ActiveSheet


'tempPointer = 4

.Range(rng).CopyFromRecordset adors
'MsgBox adors.Fields.Count
'--------Header Data-----------------
For counter = 1 To adors.Fields.Count
.Cells(2, counter) = adors.Fields(counter - 1).Name
'tempPointer = tempPointer + 1
Next
'------------------------------------

End With

End With
ExcelApp.Application.ScreenUpdating = True

'ExcelSht.Range("A1").CopyFromRecordset adors


adors.Close
adoConn.Close
Set adors = Nothing
Set adoConn = Nothing

Set ExcelSht = Nothing

Set ExcelWkb = Nothing
Set ExcelApp = Nothing
'ExcelApp.Quit

End Sub

Any ideas on why such behaviour is happening? Thanks for the advices.

 

[ghudson]

Remove the On Error Resume Next commands so that you can see the errors if and when they happen. You then need to trap for those specific errors and do what is needed to prevent or allow the code to continue on those errors depending on the situation.

 

[acesQuer]

Hi,

I received the following error for the second subroutine when I commented off the (ON Error Resume Next) statement.

Error: Run-time error '429'
Activex component can't create object

Any idea how to solve this?

Remove the On Error Resume Next commands so that you can see the errors if and when they happen. You then need to trap for those specific errors and do what is needed to prevent or allow the code to continue on those errors depending on the situation.

 

[Galaxiom]

The arguments to GetObject() are strings so require quote delimiters.

Set ExcelApp = GetObject(, "Excel.Application")

 

[acesQuer]

Hi,

Solved the problem. However the performance issue still exists. I am wondering if this is access default performance behavior??

Running access to process queries (12 queries) simultaneously seems too much for it to handle as the queries are querying huge dataset.

When I close and restart access, everything works fine. The only problem is that I have to close and restart Access after running the queries.

Any fix guys?

 

[acesQuer]

Hi,

Are there any updates with regard to the performance issue above?

Thanks