Link to home
Start Free TrialLog in
Avatar of Peter Chan
Peter ChanFlag for Hong Kong

asked on

Issue to DLookup in VBA

Hi,
How to resolve issue with DLookup to line below? I want to validate if table "Week8-13" is existing within Access database. If that is not existing, then further copy details of T1 table into table "Week8-13".

Public Function TblExists(ByVal strTableName As String) As Boolean
TblExists = False
If Not IsNull(DLookup("Name", "MSysObjects", "Name = " & Chr(34) & strTableName & Chr(34) & " AND Type = 1")) Then TblExists = True
End Function



Open in new window

Avatar of als315
als315
Flag of Russian Federation image

What is used: Excel VBA or Access VBA?
Avatar of Peter Chan

ASKER

Within VBA (Excel).
To validate it against Access DB.
Here is a revision

Public Function TblExists(ByVal strTableName As String) As Boolean
Dim blnExists As Boolean
Dim searchResult
blnExists = False
 
searchResult = DLookup("Name", "MSysObjects", "Name = '" & strTableName & "' AND Type = 1")
If Len(Nz(searchResult, vbNullString)) = 0 Then
Else
blnExists = True
End If
TblExists = blnExists
End Function



Open in new window

Dlookup is an Access specific function. To use it from within Excel you must have an Access Object declared, on which it is working.
E.g.
Dim app as New Access.Application
App.OpenCurrentDatabase(YourFilePath)
If Not IsNull(App.DLookup("Name", "MSysObjects", "Name = " & Chr(34) & strTableName & Chr(34) & " AND Type = 1")) Then TblExists = True

Open in new window

 
Alternatively if you already have a connection established, you can use that to query the MSysObjects table.
John,
It is same error per attached
1h.png
I missed the Excel parameter...Anders gave the solution
Can you help to issue attached1i.png, when running the file?

I would use my own CurrentDb() as he wants to do more with that database, e.g. something like:

Option Explicit

Public Sub Test()

  MsgBox TableExists("T1")
  ReleaseReferences ' Call once your done.

End Sub

Open in new window

with

Option Explicit

Private Const DATABASE_FILENAME As String = "C:\Temp\Tests\Db1.accdb" ' Can also be a read from a cell or an explicit parameter.

' Microsoft Office 12+ Access database engine Object Library"
' Or use late binding.
Private m_CurrentDbEngine As DAO.DBEngine
Private m_CurrentDb As DAO.Database

Public Property Get CurrentDb() As DAO.Database

  If m_CurrentDb Is Nothing Then
    Set m_CurrentDbEngine = New DAO.DBEngine
    Set m_CurrentDb = m_CurrentDbEngine.OpenDatabase(DATABASE_FILENAME)
  End If
  
  Set CurrentDb = m_CurrentDb
  
End Property

Public Sub ReleaseReferences()

  If Not m_CurrentDb Is Nothing Then
    m_CurrentDb.Close
    Set m_CurrentDb = Nothing
  End If

  If Not m_CurrentDbEngine Is Nothing Then
    Set m_CurrentDbEngine = Nothing
  End If

End Sub

Public Function TableExists(ByVal CTableNAme As String) As Boolean
 
  Const NO_ERROR As Long = 0
  
  On Local Error GoTo 0

  Dim TableDef As DAO.TableDef

  Err.Clear
  Set TableDef = CurrentDb.TableDefs(CTableNAme)
  TableExists = (Err.Number = NO_ERROR And Not TableDef Is Nothing)
  Set TableDef = Nothing
  
End Function

Open in new window

Escape the parameter to avoid SQL injection and use DCount() and  Boolean expressions instead of If, I think it's better readable. And as we need to escape normally often, use a function:

Option Explicit

Private Const DATABASE_FILENAME As String = "C:\Temp\Tests\Db1.accdb" ' Can also be a read from a cell or an explicit parameter.

Private m_CurrentApplication As Access.Application

Public Property Get CurrentApplication() As Access.Application

  If m_CurrentApplication Is Nothing Then 
    Set m_CurrentApplication = New Access.Application    ​
     m_CurrentApplication.OpenCurrentDatabase(DATABASE_FILENAME)
  End If
 ​
  ​Set CurrentApplication = m_CurrentApplication
 ​
End Property

Public Sub ReleaseReferences()

  If Not m_CurrentApplication Is Nothing Then
    m_CurrentApplication.CloseCurrentDatabase
    Set m_CurrentApplication = Nothing
  End If

End Sub

Public Function SqlQuoteStr(ByVal CString As String, ByVal Optional CDelimiter As String = "'") As String

 ​SqlQuoteStr = CDelimiter & Replace(CString, CDelimiter, CDelimiter & CDelimiter) & CDelimiter

End Function

Public Function TableExists(ByVal CTableName As String) As Boolean

 ​TableExists = (CurrentAccess.DCount("Name", "MSysObjects", "Name = " & SqlQuoteStr(CTableName) & " AND Type = 1;") > 0)

End Function

Open in new window

Thanks Stephen.

What should be acTable declared, per attached issue?1j.png
Using Access.Application requires the at you reference the Microsoft Access 12+ Object Library.
Sorry, do you see my screenshot in above? What should be acTable declared as?
Yes. Did you read my post above?

When having that reference, then it is resolved automatically.
And you can use the object browser to lookup that value. E.g.

User generated image
Hi,
How to correct attached error 1k.png due to last line below?
Public Function TblExists(ByVal para_db As String, ByVal CTableNAme As String) As Boolean
 
  Const NO_ERROR As Long = 0
 
  On Local Error GoTo 0


  Dim TableDef As DAO.TableDef


  Err.Clear
  Set TableDef = para_db.TableDefs(CTableNAme)
  TableExists = (Err.Number = NO_ERROR And Not TableDef Is Nothing)
  Set TableDef = Nothing
 
End Function


    Dim Adb As Object, acTable As Object


    Dim Adb As Object, acTable As Object
    Set Adb = CreateObject("Access.Application"): Call Adb.OpenCurrentDatabase(F1)
    Adb.Visible = False
   
    If TblExists(Adb, ActiveSheet.Name) Then



Open in new window

You're mixing strategies. My first post uses DAO only. The second post use Access as proposed by Anders.

As long as you're developing your solution, use early binding and the references. This will give you the answer to your question automatically. Adb is not of type DAO.Database.

p.s. as you haven't told us much about your context. I strongly recommend not to handle the application or database like you do.
Hi,
I used db instead below (to TblExists). But how to adjust with statement below?
    Dim db As DAO.Database
   
    Set db = DBEngine(0).OpenDatabase(F1)
   
    'db.Close
   
    If TblExists(db, ActiveSheet.Name) Then
       
        With Adb
            'DoCmd.SetWarnings False
            '.DoCmd.RunSQL s0
            .DoCmd.DeleteObject acTable, ActiveSheet.Name
            'DoCmd.SetWarnings True
        End With
   
    End If


        With Adb
            'DoCmd.SetWarnings False
            '.DoCmd.RunSQL s0
            .DoCmd.CopyObject , ActiveSheet.Name, acTable, "t1"
            'DoCmd.SetWarnings True
        End With



Open in new window

But how to adjust with statement below?
By choosing one strategy and implementing it. You are still mixing plain DAO with full Access automation.
As most of my code is not using Dao.Database, can I adjust TblExists to use Adb instead, which is declared like

    Dim Adb As Object, acTable As Object
    Set Adb = CreateObject("Access.Application"): Call Adb.OpenCurrentDatabase(F1)



Open in new window

Test sample (sligtly modified Ste5an's code)
Update references according to your office version
test.xlsm
Als,
Thanks a lot.
Can you share the way to run query

select * into [Week8-13] from t1;

Open in new window


based on definition below you're using

    Set m_CurrentDbEngine = New DAO.DBEngine
    Set m_CurrentDb = m_CurrentDbEngine.OpenDatabase(Cells(1, 2))



Open in new window

Try
CurrentDB.Execute "select * into [Week8-13] from t1"
Hi,
Can you help to error "Invalid operation" due to last line below?

Option Explicit
Private mDbEngine As DAO.DBEngine
Private mCurrDB As DAO.Database
...
    Do While True
        RowID = RowID + 1
        If Trim(ActiveSheet.Cells(RowID, 1).Value) = "" Then
            Exit Do
        End If
        s0 = "insert into t1 values (" & CStr(RowID) & ",'" & Trim(ActiveSheet.Cells(RowID, 1).Value) & "','" & Trim(ActiveSheet.Cells(RowID, 2).Value) & "','" & _
            Trim(ActiveSheet.Cells(RowID, 3).Value) & "','" & Trim(ActiveSheet.Cells(RowID, 4).Value) & "','" & Trim(ActiveSheet.Cells(RowID, 5).Value) & _
            "','" & Trim(ActiveSheet.Cells(RowID, 6).Value) & "','" & Trim(ActiveSheet.Cells(RowID, 7).Value) & "','" & _
            Trim(ActiveSheet.Cells(RowID, 8).Value) & "','" & Trim(ActiveSheet.Cells(RowID, 9).Value) & "','" & Trim(ActiveSheet.Cells(RowID, 10).Value) & "');"
   
        Set rs = mCurrDB.openrecordset(s0)



Open in new window

ASKER CERTIFIED SOLUTION
Avatar of als315
als315
Flag of Russian Federation image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Yes, I have corrected it. Please see error like1m.png

due to last line below
    Do While True
        RowID = RowID + 1
        If Trim(ActiveSheet.Cells(RowID, 1).Value) = "" Then
            Exit Do
        End If
        s0 = "insert into [" & ActiveSheet.Name & "] values (" & CStr(RowID) & ",'" & Trim(ActiveSheet.Cells(RowID, 1).Value) & "','" & Trim(ActiveSheet.Cells(RowID, 2).Value) & "','" & _
            Trim(ActiveSheet.Cells(RowID, 3).Value) & "','" & Trim(ActiveSheet.Cells(RowID, 4).Value) & "','" & Trim(ActiveSheet.Cells(RowID, 5).Value) & _
            "','" & Trim(ActiveSheet.Cells(RowID, 6).Value) & "','" & Trim(ActiveSheet.Cells(RowID, 7).Value) & "','" & _
            Trim(ActiveSheet.Cells(RowID, 8).Value) & "','" & Trim(ActiveSheet.Cells(RowID, 9).Value) & "','" & Trim(ActiveSheet.Cells(RowID, 10).Value) & "');"
   
        mCurrDB.Execute s0, dbFailOnError

Open in new window



Hi John,
Further to our message, I copy relevant query (from Excel) and run it in Access. I encounter attached message and chose Yes to go. But then I do not see record in Access table. You can see attached DB file if possible.

Many Thanks & Best Regards,
Peter

Db1.accdb1o.png
INSERT INTO [Week8-13] ( ID,Trade, Vessel, Voyage, Leg, POR, [S/O NO FROM], [S/O NO TO], [Number to increment])
VALUES('51', "JTS", "YC3", 2, "S", "TW", 8500, 8599, 1;

Open in new window

Hi,
Must I put column names to query? It does stop to last line below

insert into [Week8-13] values (3,'JTS','YC3','2','S','TWKSG','8001','8179','7','8008','8001 8002 8003 8004 8005 8006 8007');
insert into [Week8-13] values (4,'JTS','YC3','2','S','TWTXG','8200','8299','3','8203','8200 8201 8202');
insert into [Week8-13] values (5,'JTS','YC3','2','S','TWTYG','8500','8599','1','','');

I do not know why I cannot run last line above, against DB file.
Just do it in steps

I put also column name to that, and still there is same problem to do insert.
You can't run last line because you have missing values

Peter! Good sample (Excel and Access) could save us a lot of time. I see errors in data conversion, but I don't see your worksheet and can't check your query
If the SQL INSERT statement holds values for all the columns you don't need column names
If you want to do a partial insert then you should use column names.