Access Object causes an error in excel

[Bharat]

I have setup an excel spreadsheet into which users enter
data after which they press a button which :

copies the data into an array
opens an instance or Access
runs a query to see if the data already exists
or appends the data into a table.

I have used the "Object Quit" and "Set Object = Nothing"
Statements to remove any reference to Access. Every thing
works fine the first time I click on the the button after
opening the workbook. However If I click on the button to
run the procdeures again it generares an error: If I close
the spreadsheet and reopen it or reset the code when it
goes into the degub mode this error doesn't occur.

Runtime Error '462'
The remote server machine does not exist or is unavailable


I have copied the code below. All help will be gratefuly
received as I have been wotking to solve this one bug for
about 4 hours. It only took me an hour to write it.


-----------------------------------------------------------
---------------------

Option Explicit
Option Base 1
Dim aryAtmData() As Variant
Dim objAccess As Access.Application
Dim rst As DAO.Recordset


-----------------------------------------------------------
---------------------

Private Sub CommandButton1_Click()
Dim var1 As String
Dim I As Integer


I = 7

var1 = Format(Date, "YYYY")


If IsNull(lstMonth.Value) Then
MsgBox "You have COCKED UP. There are clear instructions
asking you to select a month."
lstMonth.SetFocus
Exit Sub
End If

If lstYear.Value > var1 Or IsNull(lstYear.Value) Then
MsgBox "You have COCKED UP. How can you select or not
select a Year for which you have no data." & vbCrLf
& "CORRECT IT!"
lstYear.SetFocus
Exit Sub
End If
Range("h7").Value = lstMonth.Value
Range("i7").Value = lstYear.Value
Range("H7:I7").Copy
Range("H7").Select
Do While Cells(I, 7).Value <> ""
Cells(I, 8).Select
ActiveSheet.Paste
I = I + 1
Loop

aryAtmData = Range(Cells(7, 4), Cells(I - 1, 9))

Set objAccess = CreateObject("access.Application")
objAccess.OpenCurrentDatabase ("C:\Documents and
Settings\Bharat.Odedra\Desktop\ATM Database.mdb")

If updatetoatmdb Then
Set rst = Nothing
objAccess.Quit
Set objAccess = Nothing
UserForm1.Hide
Exit Sub
End If


Set rst = Nothing
objAccess.Quit
Set objAccess = Nothing
UserForm1.Hide

End Sub

-----------------------------------------------------------
---------------------



Private Sub UserForm_Initialize()

lstMonth.RowSource = "M7:M18"
lstYear.RowSource = "N7:N10"
'lstYear.ControlSource = "N7"

End Sub


-----------------------------------------------------------
---------------------


Public Function updatetoatmdb() As Boolean

Dim strSQLCheck, strSQLAdd, AtmId, Month, Year As String
Dim Avail As Single
Dim WithD As Currency
Dim Trans As Long
Dim I, Ans As Integer
Dim AccessRunning As Boolean



With objAccess

For I = 1 To UBound(aryAtmData, 1)
AtmId = CStr(aryAtmData(I, 1))
Avail = CSng(aryAtmData(I, 2))
WithD = CCur(aryAtmData(I, 3))
Trans = CLng(aryAtmData(I, 4))
Month = CStr(aryAtmData(I, 5))
Year = CStr(aryAtmData(I, 6))

strSQLCheck = "SELECT tblATMDataAll.ATMid,
tblATMDataAll.Month, tblATMDataAll.Year FROM
tblATMDataAll " _
& "WHERE (((tblATMDataAll.ATMid)=""" & AtmId & """)
AND ((tblATMDataAll.Month)=""" & Month & """) AND
((tblATMDataAll.Year)=""" & Year & """));"

Set rst = CurrentDb.openrecordset(strSQLCheck)

If rst.RecordCount > 0 Then

Ans = MsgBox("LOOK HERE NOW." & vbCrLf & "ATM " &
AtmId & " already has data in the database for " & Month
& " In " & Year & ". To continue with this operation click
on " & vbCrLf & "OK to add this data again and get this
message for all duplicate entries or click on cancel to
stop so you can go back and correct your error.",
vbCritical + vbOKCancel + vbApplicationModal +
vbDefaultButton2)

If Ans = vbCancel Then
updatetoatmdb = True
Exit Function
End If

End If

strSQLAdd = "INSERT INTO tblATMDataAll ( ATMid,
Availability, Withdrawls, Transactions, Month, Year) " _
& "VALUES ( """ & AtmId & """,""" & Avail & ""","""
& WithD & """,""" & Trans & """,""" & Month & """,""" &
Year & """ )"
DoCmd.SetWarnings False
DoCmd.RunSQL strSQLAdd
DoCmd.SetWarnings True

Next I
End With


End Function

Thanks
Bharat

 

[merjet]

There is really no need to open Access.

Replace:
Dim objAccess As Access.Application
Set objAccess = CreateObject("access.Application")
objAccess.OpenCurrentDatabase ("C:\Documents and
Settings\Bharat.Odedra\Desktop\ATM Database.mdb")

With:
Dim db As Database
Set db = DBEngine.Workspaces(0).OpenDatabase("as above")

Of course, Microsoft DAO x.x Object Library must be checked
at the menu Tools | References.

HTH,
Merjet

 

[merjet]

P.S.
To close:
db.Close
Set db=Nothing

HTH,
Merjet