set obj as New Access.Application visible flash

[Rx_]

Any suggestion on how to avoid the remote Access DB screen from flashing during code execution?

set object as New Access.Application inside two functions.
setting the objAccess.Visible = False still relults in the remote screen application screen flash and loss of focus on my primary application

Won't go into detail, can not use linked tables.
The code reports current number of records and date on a remote unsecured Access 2007 database: before, after table deletion, and after reposting data

The code at line 90 works great. Maybe there is a way to return the data in the functions with the same type of CurrentDb.Execute process?

Private Sub cmdPublishToRemoteGISDatabaseTable_Click()
      Dim MySQL As String
      Dim DBPath As String
      Dim Result
      Dim TblName As String
      Dim RecordCount As Long
      Dim RecordCountMessage
10    On Error GoTo PROC_ERROR
20    DoCmd.Hourglass True
30       DBPath = "X:\Reg_production.accdb"  ' Subscriber DB
40       TblName = "Reg_GIS"
50            MySQL = "SELECT View_GIS.Area, View_GIS.Well_Name, View_GIS.Req_Fin, View_GIS.SHLBHL   " & _
              "INTO Reg_GIS    IN '" & DBPath & _
              "' FROM View_GIS;"
 
60        MsgBox "Before Delete there were " & CountRecords(DBPath, TblName) & " Records with oldest date of " & OldestDate(DBPath, TblName)
70       Result = DeleteTableFromBackEnd(DBPath, TblName)
80        MsgBox "Old GIS data and Table deleted status is : " & Result & "   And now there are " & CountRecords(DBPath, TblName) & " Records   with oldest date of " & OldestDate(DBPath, TblName)
 
90       CurrentDb.Execute MySQL, dbFailOnError
          MsgBox "External DB Repopulated with current data, now there are : " & Result & "   And now there are " & CountRecords(DBPath, TblName) & " Records     with oldest date of " & OldestDate(DBPath, TblName)
110      DoCmd.Hourglass False
PROC_EXIT:
120       On Error Resume Next
130         DoCmd.Hourglass False
140       Exit Sub
PROC_ERROR:
150       Select Case Err.Number
              Case 3010
160                 MsgBox "The table was not delete before refreshing it, possibly due to network delay please try again", "Update Remote DB"
170           Case Else
180                 MsgBox " please make a note of this unknown error: " & Err.Description, "Unknown Error"
190               Resume PROC_EXIT
200       End Select
End Sub

Function OldestDate(RemoteDatabase As String, RemoteTable As String)
10    On Error Resume Next
      Dim objAccess As Access.Application
20    Set objAccess = New Access.Application
30        objAccess.OpenCurrentDatabase RemoteDatabase
          objAccess.Visible = False
40        OldestDate = objAccess.DMin("[Publish_Date]", RemoteTable)
50        If Err.Number = 2110 Then
60            OldestDate = 0  ' If table is deleted report 0 records
70            Err.Clear
80        End If
90        objAccess.CloseCurrentDatabase
100       Set objAccess = Nothing
End Function

Function CountRecords(RemoteDatabase As String, RemoteTable As String)
10    On Error Resume Next
      Dim objAccess As Access.Application
20    Set objAccess = New Access.Application
30        objAccess.OpenCurrentDatabase RemoteDatabase
          objAccess.Visible = False
40        CountRecords = objAccess.DCount("*", RemoteTable)
50        If Err.Number = 2110 Then
60            CountRecords = 0  ' If table is deleted report 0 records
70            Err.Clear
80        End If
90        objAccess.CloseCurrentDatabase
100       Set objAccess = Nothing          
End Function

Function DeleteTableFromBackEnd(DBPath As String, TblName As String)
      Dim Db As dao.Database
10        On Error Resume Next       
20        Set Db = OpenDatabase(DBPath)
30        If Err <> 0 Then     'failed to open back end database
40            DeleteTableFromBackEnd = False
50            Db.Close
60            Set Db = Nothing
70            Exit Function
80        Else
90            Db.Execute "DROP TABLE [" & TblName & "]"
100           If Not Db Is Nothing Then Db.Close
110           DeleteTableFromBackEnd = True
120       End If
130       Db.Close
140       Set Db = Nothing
End Function

 

[MarkK]

You definitely don't need to open Access to get at data in Jet tables. Yes the Access.Application object exposes the domainaggregate functions like DMin(), but there are much lighter weight options. One option is to open a DAO.Database object using the DBEngine, so code like ...

function test as variant
  dim dbs as dao.database
  dim rst as dao.recordset
  set dbs = dbengnine.opendatabase("C:\Yourpath\Yourdb.mdb")
  set rst = dbs.openrecordset( _
    "SELECT Min(Field) FROM RemoteTable WHERE SomeCondition = True")
  test = rst.fields(0)
  rst.close
end function

You can use ADO.
You can also use DAO to open a recordset directly against a table in an Access file, so code like...

Function GetMin() as variant
  GetMin = CurrentDb.OpenRecordset( _
      "SELECT Min(Field1) " & _
      "FROM tTable IN 'c:\PathToYourRemoteDB\YourDB.mdb'").Fields(0)
End Function

Cheers,
Mark

 

[Rx_]

But of course! I am so use to linked tables or using DAO on the current database. Don't get old like me or you will forget the things you did a few months ago. Thanks so much. I can take this live this afternoon.

For the benefit of others (or for my own memory in two months) here is the modified code. It is extremely fast as suggested.

Function DeleteTableFromBackEnd(DBPath As String, TblName As String)
      Dim Db    As DAO.Database
      Dim rst   As DAO.Recordset
      Set Db = DBEngine.OpenDatabase(DBPath)
10        On Error Resume Next
30        If Err <> 0 Then     'failed to open back end database
40            DeleteTableFromBackEnd = False
50            Db.Close
55            rst.Close
60            Set Db = Nothing
70            Exit Function
80        Else
90            Db.Execute "DROP TABLE [" & TblName & "]"
100           If Not Db Is Nothing Then Db.Close
110           DeleteTableFromBackEnd = True
120       End If
125       rst.Close
130       Db.Close
140       Set Db = Nothing
End Function
 
Function CountRecords(RemoteDatabase As String, RemoteTable As String)
10    On Error Resume Next
30     CountRecords = CurrentDb.OpenRecordset("SELECT count([Publish_Date]) FROM " & RemoteTable & " IN '" & RemoteDatabase & "'").Fields(0)
50        If Err.Number = 3078 Then
60            CountRecords = 0  ' If table is deleted report 0 records
70            Err.Clear
80        End If
 
End Function
 
Function OldestDate(RemoteDatabase As String, RemoteTable As String)
10    On Error Resume Next
30        OldestDate = CurrentDb.OpenRecordset("SELECT Min([Publish_Date]) FROM " & RemoteTable & " IN '" & RemoteDatabase & "'").Fields(0)
50        If Err.Number = 3078 Then
60            OldestDate = 0  ' If table is deleted report 0 records
70            Err.Clear
80        End If
End Function