I wrote a program in MS Access that when user clicks on a command button on the form, data would be extract from a query table into a new MS Excel worksheet using OLEDB.
My error is strange because the error does not occur everytime I click on the command button and there is a patten when the error message appears. So first time I clicked on command button, MS excel worksheet will populate the data with no error. I closed the MS Excel worksheet, click on command button again and error message would come up. Third time no error message. Fourth time has the error message and so on.
Here is my code: Grey color part isn't relevant so can be ignored I just didn't want to not display it in case it might matter. Red is where error occurs.
Private Sub ExportCmd_Click()
Dim MyXL As Object 'Excel Application Object
Dim XL_File As String
'Create the Excel Application Object.
Set MyXL = CreateObject("Excel.Application")
'Create new Excel Workbook
MyXL.Workbooks.Add
MyXL.Application.Visible = True
Dim cnAccess As ADODB.Connection
Set cnAccess = New ADODB.Connection
Dim strCon As String
strCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source= S:\EGB Gaming Lab\Shared\@General Use\QA Project\MasterGL Training Grid Database.mdb"
cnAccess.Open (strCon)
Dim objChecks As ADODB.Recordset
Set objChecks = New ADODB.Recordset
Dim sqlSelect As String
sqlSelect = "Select checks from checksquery"
Set objChecks = cnAccess.Execute(sqlSelect)
objChecks.MoveFirst
Dim rowInt As Integer
rowInt = 5
Dim rowString As String
Do Until objChecks.EOF
rowString = "C" & Trim(Str(rowInt))
MyXL.Worksheets("sheet1").Range(rowString) = objChecks(0)
rowInt = rowInt + 1
objChecks.MoveNext
Loop
sqlSelect = "Select checkscategory from checksquery"
Set objChecks = cnAccess.Execute(sqlSelect)
objChecks.MoveFirst
rowInt = 5
Dim rowIntPrevious As Integer
rowIntPrevious = 4
Dim rowStringPrevious As String
Dim i, j, k As Integer
i = Int(255 * Rnd) + 1
j = Int(255 * Rnd) + 1
k = Int(255 * Rnd) + 1
Do Until objChecks.EOF
rowString = "B" & Trim(Str(rowInt))
rowStringPrevious = "B" & Trim(Str(rowIntPrevious))
MyXL.Worksheets("sheet1").Range(rowString) = objChecks(0)
If Not (MyXL.Worksheets("sheet1").Range(rowString) = MyXL.Worksheets("sheet1").Range(rowStringPrevious)) Then
i = Int(255 * Rnd) + 1
j = Int(255 * Rnd) + 1
k = Int(255 * Rnd) + 1
End If
MyXL.Worksheets("sheet1").Range(rowString).Interior.Color = RGB(j, k, i)
rowInt = rowInt + 1
rowIntPrevious = rowIntPrevious + 1
objChecks.MoveNext
Loop
sqlSelect = "Select manufacturer from platformQuery"
Set objChecks = cnAccess.Execute(sqlSelect)
MyXL.Worksheets("sheet1").Range("D3").Select
objChecks.MoveFirst
Do Until objChecks.EOF
ActiveCell.Value = objChecks(0) *error occurs here*
If Not (ActiveCell.Offset(0, 0).Value = ActiveCell.Offset(0, -1).Value) Then
i = Int(255 * Rnd) + 1
j = Int(255 * Rnd) + 1
k = Int(255 * Rnd) + 1
End If
ActiveCell.Interior.Color = RGB(j, k, i)
ActiveCell.Offset(0, 1).Select
objChecks.MoveNext
Loop
sqlSelect = "Select platform from platformQuery"
Set objChecks = cnAccess.Execute(sqlSelect)
MyXL.Worksheets("sheet1").Range("D4").Select
objChecks.MoveFirst
Do Until objChecks.EOF
ActiveCell.Value = objChecks(0)
ActiveCell.Offset(0, 1).Select
objChecks.MoveNext
Loop
Set MyXL = Nothing
cnAccess.Close
End Sub
Bookmarks