Test If Access Table Is Open?

D

Dave

From Excel 2007, I am pulling data from a 2007 Access table
(regardless if db is open or not) to dump it into a spreadsheet. I
want to test if the Access table (not just the db) is open before
importing the data. The closest thing I have found is the Access
sysCmd object and the property acObjStateOpen. What I need is an
equivalent that I can run in Excel. Does anybody know how to test
(from within Excel) if an Access table is open?
 
I

isabelle

hi,

Sub test()
Dim MyFile As String
MyFile = "C:\Program Files\Microsoft Office\Office10\Samples\Comptoir.mdb"
If Not IsFileOpen(MyFile) Then
MsgBox "file is NOT open"
Else
MsgBox "file is open"
End If
End Sub

Function IsFileOpen(FileName As String)
Dim iFilenum As Long
Dim iErr As Long

On Error Resume Next
iFilenum = FreeFile()
Open FileName For Input Lock Read As #iFilenum
Close iFilenum
iErr = Err
On Error GoTo 0

Select Case iErr
Case 0: IsFileOpen = False
Case 70: IsFileOpen = True
Case Else: Error iErr
End Select

End Function


--
isabelle



Le 2011-11-24 09:09, Dave a écrit :
 
D

Dave

hi,

Sub test()
Dim MyFile As String
MyFile = "C:\Program Files\Microsoft Office\Office10\Samples\Comptoir.mdb"
     If Not IsFileOpen(MyFile) Then
         MsgBox "file is NOT open"
     Else
         MsgBox "file is open"
     End If
End Sub

Function IsFileOpen(FileName As String)
     Dim iFilenum As Long
     Dim iErr As Long

     On Error Resume Next
     iFilenum = FreeFile()
     Open FileName For Input Lock Read As #iFilenum
     Close iFilenum
     iErr = Err
     On Error GoTo 0

     Select Case iErr
     Case 0:    IsFileOpen = False
     Case 70:   IsFileOpen = True
     Case Else: Error iErr
     End Select

End Function

--
isabelle

Le 2011-11-24 09:09, Dave a écrit :




- Show quoted text -

I appreciate the code, but doesn't this simply test if the db
(database) is open? As mentioned, I need to drill down to the table.
It's OK to run the code in Excel if the database is open...just not
one specific table.
 
D

Dave

do you use ActiveSheet.QueryTables.Add ?

isabelle
part of what I have in Excel:

Set dbs = OpenDatabase("\\FullPath\myDatabase.mdb", , True)
Set rst = dbs.OpenRecordset("tblBalance", dbOpenDynaset, dbReadOnly)
Worksheets("tblBalance").Unprotect
Worksheets("tblBalance").Range("A2").CopyFromRecordset rst
'Worksheets("tblBalance").Protect
dbs.Close

I would like to block access to the table if it is open (say, for
maintenance). I don't think different record locking options can be
set for Access tables so I'm looking for an "is it open" test to be
run from Excel. There is a similar test for Access:
sysCmd(acSyscmdGetObjectState, acTable, "tblName") = acObjStateOpen
 
I

isabelle

hi Dave,

i opened up the Comptoir.mdb file and i opened the table "Clients" for editing.
and on excel i have executed the macro "test" with no problem.
i also did a test when Comptoir.mdb have being closed, and there is no problem.

Sub test()
DAOCopyFromRecordSet "C:\Program Files\Microsoft Office\Office10\Samples\Comptoir.mdb", _
"Clients", "Fonction", " = 'Propriétaire'", Range("A1")
End Sub


Sub DAOCopyFromRecordSet(DBFullName As String, TableName As String, _
FieldName As String, Criteria As String, TargetRange As Range)

Dim db As Database, rs As Recordset
Dim intColIndex As Integer
Set TargetRange = TargetRange.Cells(1, 1)
Set db = OpenDatabase(DBFullName)

' Set rs = db.OpenRecordset(TableName, dbOpenTable) ' all records
Set rs = db.OpenRecordset("SELECT * FROM " & TableName & _
" WHERE " & FieldName & Criteria, dbReadOnly) ' filter records

' write field names
For intColIndex = 0 To rs.Fields.Count - 1
TargetRange.Offset(0, intColIndex).Value = rs.Fields(intColIndex).Name
Next

' write recordset
TargetRange.Offset(1, 0).CopyFromRecordset rs

Set rs = Nothing
db.Close
Set db = Nothing
End Sub
 
D

Dave

hi Dave,

i opened up the Comptoir.mdb file and i opened the table "Clients" for editing.
and on excel i have executed the macro "test" with no problem.
i also did a test when Comptoir.mdb have being closed, and there is no problem.

Sub test()
DAOCopyFromRecordSet "C:\Program Files\Microsoft Office\Office10\Samples\Comptoir.mdb", _
     "Clients", "Fonction", " = 'Propriétaire'", Range("A1")
End Sub

Sub DAOCopyFromRecordSet(DBFullName As String, TableName As String, _
     FieldName As String, Criteria As String, TargetRange As Range)

Dim db As Database, rs As Recordset
Dim intColIndex As Integer
     Set TargetRange = TargetRange.Cells(1, 1)
     Set db = OpenDatabase(DBFullName)

'    Set rs = db.OpenRecordset(TableName, dbOpenTable) ' all records
     Set rs = db.OpenRecordset("SELECT * FROM " & TableName & _
         " WHERE " & FieldName & Criteria, dbReadOnly) ' filterrecords

     ' write field names
     For intColIndex = 0 To rs.Fields.Count - 1
         TargetRange.Offset(0, intColIndex).Value = rs.Fields(intColIndex).Name
     Next

     ' write recordset
     TargetRange.Offset(1, 0).CopyFromRecordset rs

     Set rs = Nothing
     db.Close
     Set db = Nothing
End Sub

Tried your example (full path is same as what works now regardless of
tbl being open, just not shown here)

Sub test()
DAOCopyFromRecordSet "\\...dbname.mdb", _
"tblBalance", "*", " = '*'", Range("A2")
End Sub

Sub DAOCopyFromRecordSet(DBFullName As String, TableName As String, _
FieldName As String, Criteria As String, TargetRange As Range)

Dim db As Database, rs As Recordset
Dim intColIndex As Integer
Set TargetRange = TargetRange.Cells(1, 1)
Set db = OpenDatabase(DBFullName)
* Set rs = db.OpenRecordset(TableName, dbOpenTable) ' all records
'Set rs = db.OpenRecordset("SELECT * FROM " & TableName & _
" WHERE " & FieldName & Criteria, dbReadOnly) ' filter
records
' write field names
For intColIndex = 0 To rs.Fields.Count - 1
TargetRange.Offset(0, intColIndex).Value =
rs.Fields(intColIndex).Name
Next
' write recordset
TargetRange.Offset(1, 0).CopyFromRecordset rs
Set rs = Nothing
db.Close
Set db = Nothing
End Sub
I get an error (3219) "Application-defined or object-defined" message
at the line I marked with *. I noticed you do not dim the db or rs
specifically as DAO. I tried specific references and got the same
error. I do have a reference to DAO 3.6 and VBA 5.3. So why would this
work for you and not me?
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top