Peter Chan
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".
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
What is used: Excel VBA or Access VBA?
ASKER
Within VBA (Excel).
To validate it against Access DB.
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
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.
Alternatively if you already have a connection established, you can use that to query the MSysObjects table.
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
Alternatively if you already have a connection established, you can use that to query the MSysObjects table.
ASKER
I missed the Excel parameter...Anders gave the solution
ASKER
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
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
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
ASKER
Using Access.Application requires the at you reference the Microsoft Access 12+ Object Library.
ASKER
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.
When having that reference, then it is resolved automatically.
And you can use the object browser to lookup that value. E.g.
ASKER
Hi,
How to correct attached error 1k.png due to last line below?
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
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.
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.
ASKER
Hi,
I used db instead below (to TblExists). But how to adjust with statement below?
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
But how to adjust with statement below?By choosing one strategy and implementing it. You are still mixing plain DAO with full Access automation.
ASKER
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)
Test sample (sligtly modified Ste5an's code)
Update references according to your office version
test.xlsm
Update references according to your office version
test.xlsm
ASKER
Als,
Thanks a lot.
Can you share the way to run query
based on definition below you're using
Thanks a lot.
Can you share the way to run query
select * into [Week8-13] from t1;
based on definition below you're using
Set m_CurrentDbEngine = New DAO.DBEngine
Set m_CurrentDb = m_CurrentDbEngine.OpenDatabase(Cells(1, 2))
Try
CurrentDB.Execute "select * into [Week8-13] from t1"
CurrentDB.Execute "select * into [Week8-13] from t1"
ASKER
Hi,
Can you help to error "Invalid operation" due to last line below?
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)
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Yes, I have corrected it. Please see error like1m.png
due to last line below
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
ASKER
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;
ASKER
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.
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
ASKER
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.
If you want to do a partial insert then you should use column names.