I google a lot and read all post here related to this issue but found nothing that could give an explanation or help me to resolve this issue.
Following here, a function which work great when the "TableName" parameter is a base table but raise error when it is an ms access view (query). I found nothing yet that could explain this issue as many access query already refer to such views (queries) without issues.
Function DBDistinctCount(FieldName As String, tableName As String) As Long
Dim rs As Recordset, curDb As Database, strSql As String
On Error GoTo ERR_Handling
Set curDb = CurrentDb
'strSql = "SELECT COUNT(PR.[" & FieldName & "]) AS CNT FROM (SELECT [" & FieldName & "] FROM " & TableName & " GROUP BY [" & FieldName & "]) AS PR;"
strSql = "SELECT COUNT(PR." & FieldName & ") AS CNT FROM (SELECT " & FieldName & " FROM " & tableName & " GROUP BY " & FieldName & ") AS PR;"
'strSql = "SELECT COUNT([" & FieldName & "]) AS CNT FROM (SELECT [" & FieldName & "] FROM [" & TableName & "] GROUP BY [" & FieldName & "]);"
'Debug.Print result: SELECT COUNT(PR.ID_Projet) AS CNT FROM (SELECT ID_Projet FROM R_CompilationProjet GROUP BY ID_Projet) AS PR
' Dim qdf As DAO.QueryDef
' Set qdf = curDb.CreateQueryDef(vbNullString, strSql)
Set rs = curDb.OpenRecordset(strSql)
' Set rs = qdf.OpenRecordset(dbOpenSnapshot)
DBDistinctCount = Nz(rs.Fields("CNT"), 0)
ERR_Handling:
If Err.Number <> 0 Then
Dim mess As String
mess = "Erreur vba " & Err.Number & " : " & Err.Description
On Error Resume Next
Call DBHelper.AddLog(mess, "DBDistinctCount")
End If
If Not rs Is Nothing Then rs.Close
Set rs = Nothing
If Not curDb Is Nothing Then curDb.Close
Set curDb= Nothing
End Function
As you can see, I messed up the function a bit in order to find out what could be wrong. I even tried to use a querydef with the same result. I should mention that I've tried to put the resulting sql string itself inside an access query to see exactly the expected result when I ran the query. Any advice would be greatly appreciated.
Related
Background
I'm trying to use Excel VBA to load data from Microsoft Office Access database.
The code was worked fine and I am now trying to add an extra column Position drawn from the datebasetable named EqBucket into the final result table
The SQL works find in Access but it doesn't parse through to VBA.
The code break when I add in
SUM(Eq_Buckets.Position) AS PositionOfSum
I'm guess it has to do with the aggregation sum wrapped around the column because this issue has never come up with other direct referenced columns.
Appreciate for any pointers. Thanks
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Info:
1. SQL string is stored in Sheets("SQL").Range("A1").value
2. Database tables Eq_SingleName_LBU, Eq_Buckets << this is where the position data are stored
3. Eq_Portfolio_Ref is just a reference table which could be ignored
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
**IF I remove "Sum(Eq_Buckets.Position) AS PositionOfSum" the code works in VBA
Here is the FULLY working SQL code in MS Access:
SELECT Eq_SingleName_LBU.Identifier AS Identifier, Eq_SingleName_LBU.Issuer AS Issuer, Eq_SingleName_LBU.MV_USD AS MV, Sum(Eq_Buckets.Position) AS PositionOfSum, Eq_SingleName_LBU.Issuer_Weight AS [Issuer Weight], Eq_SingleName_LBU.Test_Limit AS Limit, Eq_SingleName_LBU.Room_Limit AS [Remaining Limit], Eq_SingleName_LBU.Data_Date
FROM Eq_SingleName_LBU INNER JOIN (Eq_Buckets INNER JOIN Eq_Portfolio_Ref ON Eq_Buckets.Composite_Portfolio = Eq_Portfolio_Ref.BBG_Account_Codes) ON Eq_SingleName_LBU.Identifier = Eq_Buckets.BB_UniqueID
Where Eq_Buckets.Data_Date = (#03/12/2020#) and Eq_SingleName_LBU.UnderTest="Y"
GROUP BY Eq_SingleName_LBU.Identifier, Eq_SingleName_LBU.Issuer, Eq_SingleName_LBU.MV_USD, Eq_SingleName_LBU.Issuer_Weight, Eq_SingleName_LBU.Test_Limit, Eq_SingleName_LBU.Room_Limit, Eq_SingleName_LBU.Data_Date
HAVING (((Eq_SingleName_LBU.Data_Date) In (#03/12/2020#)))
ORDER BY Eq_SingleName_LBU.Data_Date;
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Here is the VBA code that the SQL string needs to fit through
Sub ADOImportFromAccessTable()
'On Error GoTo ErrorHandler
Application.ScreenUpdating = False
Application.Calculation = xlManual
Sheets("EQ1_SQL").Visible = True
Dim con As Object
Dim rst As Object
Dim dbPath As String
dbPath = "\\Db\Asset_db.accdb"
Set con = CreateObject("ADODB.Connection")
con.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dbPath
con.Open
Set rst = CreateObject("ADODB.Recordset")
'This is where the SQL code will be referenced.
strSql = ThisWorkbook.Sheets("SQL").Range("A1").Value
Debug.Print strSql
strSql = Replace(strSql, "{date1}", Date_1)
Debug.Print strSql
strSql = Replace(strSql, "{date2}", Date_2)
rst.Open strSql, con, adOpenDynamic, adLockOptimistic
rst.Close
Set rst = Nothing
con.Close
Set con = Nothing
End sub
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Here is the error message I get from Excel VB editor
Here is the error I get from VB editor.
Run-tme error '-2147467259 (80004005);:
Method 'Open' of object' _ Recordset' failed
Try adding brackets around Position ie Sum(B.[Position]),
You can shorten the SQL by using table name aliases, for example
strSQL = " SELECT A.Identifier AS Identifier, A.Issuer AS Issuer, A.MV_USD AS MV," & _
" Sum(B.[Position]) AS PositionOfSum, " & _
" A.Issuer_Weight AS [Issuer Weight]," & _
" A.Test_Limit AS Limit, " & _
" A.Room_Limit AS [Remaining Limit]," & _
" A.Data_Date" & _
" FROM Eq_SingleName_LBU AS A " & _
" INNER JOIN Eq_Buckets AS B" & _
" ON A.Identifier = B.BB_UniqueID" & _
" WHERE B.Data_Date = #2020/12/03# " & _
" AND A.UnderTest = 'Y' " & _
" GROUP BY A.Identifier, A.Issuer," & _
" A.MV_USD, A.Issuer_Weight, A.Test_Limit," & _
" A.Room_Limit, A.Data_Date" & _
" HAVING A.Data_Date IN (#2020/12/03#) " & _
" ORDER BY A.Data_Date"
I try to create a query to Count items and having three WHERE conditions but there is no result when I run the code, not even an error one. What am I doing wrong?
Private Sub Command5_Click()
Dim db As DAO.Database
Set db = CurrentDb
Dim qdf As DAO.QueryDef
Dim qryMajorDesignReview As String
Dim tblMainReportLOI As String
qryMajorDesignReview = "SELECT Count(tblLOI.loiActivities) As MajorDesignReview, INTO tblMainReportLOI FROM tblLOI " & _
"WHERE tblLOI.loiActivities='PSG Major design review for new or existing facilities' " & _
"AND Format([loiDate], ""yyyy"")=[Forms]![frmMonthlyDivisionReports]![txtYear] " & _
"AND Format([loiDate], ""mmmm"")=[Forms]![frmMonthlyDivisionReports]![txtMonth]; "
On Error Resume Next
DoCmd.DeleteObject acTable, "tblMainReportLOI"
Err.Clear
CurrentDb.Execute qryMajorDesignReview
If Err.Number <> 0 Then
strError = Err.Description
End If
On Error GoTo 0
End Sub
Remove the comma before INTO. Also, concatenate variables. References to form controls are variables. Can use apostrophe instead of doubled quotes in Format(). Could use Year() function instead of Format.
qryMajorDesignReview = "SELECT Count(tblLOI.loiActivities) As MajorDesignReview INTO tblMainReportLOI FROM tblLOI " & _
"WHERE tblLOI.loiActivities='PSG Major design review for new or existing facilities' " & _
"AND Year([loiDate])=" & [Forms]![frmMonthlyDivisionReports]![txtYear] & _
" AND Format([loiDate], 'mmmm')='" & [Forms]![frmMonthlyDivisionReports]![txtMonth] & "'"
I hardly ever post for help and try to figure it out on my own, but now I’m stuck. I’m just trying to append data from multiple tables to one table. The source tables are data sets for each American State and the append query is the same for each State, except for a nested select script to pull from each State table. So I want to create a VBA script that references a smaller script for each state, rather than an entire append script for each state. I’m not sure if I should do a SELECT CASE, or FOR TO NEXT or FOR EACH NEXT or DO LOOP or something else.
Here’s what I have so far:
tblLicenses is a table that has the field LicenseState from which I could pull a list of the states.
Function StateScripts()
Dim rst As DAO.Recordset
Dim qryState As String
Dim StateCode As String
Set rst = CurrentDb.OpenRecordset("SELECT LicenseState FROM tblLicenses GROUP BY LicenseState;")
' and I've tried these, but they don't work
' qryState = DLookup("LicenseState", "tblLicenses")
' qryState = "SELECT LicenseState INTO Temp FROM tblLicenses GROUP BY LicenseState;"
' DoCmd.RunSQL qryState
Select Case qryState
Case "CT"
StateCode = "CT"
StateScripts = " SELECT [LICENSE NO] AS StateLicense, [EXPIRATION DATE] AS dateexpired FROM CT "
Case "AK"
StateCode = "AK"
StateScripts = " SELECT [LICENSE] AS StateLicense, [EXPIRATION] AS dateexpired FROM AK "
Case "KS"
StateCode = "KS"
StateScripts = " SELECT [LicenseNum] AS StateLicense, [ExpDate] AS dateexpired FROM KS "
End Select
CurrentDb.Execute " INSERT INTO TEST ( StLicense, OldExpDate, NewExpDate ) " _
& " SELECT State.StateLicense as StLicense, DateExpire AS OldExpDate, State.dateexpired AS NewExpDate " _
& " FROM ( " & StateScripts & " ) AS State " _
& " RIGHT JOIN tblLicenses ON (State.StateLicense = tblLicenses.LicenseNum) " _
& " GROUP BY State.StateLicense, DateExpire, State.dateexpired " _
& " HAVING (((LicenseNum) Like '*" & StateCode & "*') ; "
End Function
It sounds like you are dealing with input sources that use different column names for the same information, and you are working to merge it all into a single table. I will make the assumption that you are dealing with 50 text files that are updated every so often.
Here is one way you could approach this project...
Use VBA to build a collection of file names (using Dir() in a specific folder). Then loop through the collection of file names, doing the following:
Add the file as a linked table using VBA, preserving the column names.
Loop through the columns in the TableDef object and set variables to the actual names of the columns. (See example code below)
Build a simple SQL statement to insert from the linked table into a single tables that lists all current license expiration dates.
Here is some example code on how you might approach this:
Public Sub Example()
Dim dbs As Database
Dim tdf As TableDef
Dim fld As Field
Dim strLic As String
Dim strExp As String
Dim strSQL As String
Set dbs = CurrentDb
Set tdf = dbs.TableDefs("tblLinked")
' Look up field names
For Each fld In tdf.Fields
Select Case fld.Name
Case "LICENSE", "LICENSE NO", "License Num"
strLic = fld.Name
Case "EXPIRATION", "EXPIRATION DATE", "EXP"
strExp = fld.Name
End Select
Next fld
If strLic = "" Or strExp = "" Then
MsgBox "Could not find field"
Stop
Else
' Build SQL to import data
strSQL = "insert into tblCurrent ([State], [License],[Expiration]) " & _
"select [State], [" & strLic & "], [" & strExp & "] from tblLinked"
dbs.Execute strSQL, dbFailOnError
End If
End Sub
Now with your new table that has all the new data combined, you can build your more complex grouping query to produce your final output. I like this approach because I prefer to manage the more complex queries in the visual builder rather than in VBA code.
Thanks for your input. I came up with a variation of your idea:
I created table ("tblStateScripts"), from which the rs!(fields) contained the various column names
Dim rs As DAO.Recordset
Dim DB As Database
Set DB = CurrentDb
Set rs = DB.OpenRecordset("tblStateScripts")
If Not rs.EOF Then
Do
CurrentDb.Execute " INSERT INTO TEST ( StLicense, OldExpDate, NewExpDate ) " _
& " SELECT State.StateLicense as StLicense, DateExpire AS OldExpDate, State.dateexpired AS NewExpDate " _
& " FROM ( SELECT " & rs!FldLicenseState & " AS StateLicense, " & rs!FldExpDate & " AS DateExp " & " FROM " & rs!TblState " _
& " RIGHT JOIN tblLicenses ON (State.StateLicense = tblLicenses.VetLicense) " _
& " GROUP BY State.StateLicense, DateExpire, State.dateexpired " _
& " HAVING (((LicenseNum) Like '*" & rs!StateCode & "*') ; "
rs.MoveNext
Loop Until rs.EOF
End If
rs.Close
Set rs = Nothing
There is a button on a report that exports the underlying query of the report to excel. This function works fine as it would but I need it to take the criteria of the report. I have a massive reporting manager that will set the criteria for the report and then will open it up.
To make it easy, I want to pass me.filter to a variable which works in a different sub, but here my problem is that I need to pass the filter to be properly formatted for an sql statement I assume? The other sub just uses it as a [WhereCondition] for an open report command.
For clarification, the portion getreportsource() is a module that gets the reports source and it works fine.
Here are some example outputs of the variables as well as the code:
strRptName: TotalSalesForYear
strRptSource: qryMainDashboard
FilterCondition: TxnDate >= #11/1/2017# AND TxnDate <= #11/30/2017#
Private Sub cmdExcel_Click()
Dim strRptName As String
Dim strRptSource As String
Dim vardate As String
Dim varExportPath As String
Dim FilterCondition As String
Dim oExcel
FilterCondition = Me.filter
' Get the Report Name
strRptName = Screen.ActiveReport.Name
' Get the RecordSource of the Report from a module
strRptSource = GetReportSource(strRptName)
'Present Date
vardate = Format$(Now(), "YYYY.MM.DD_HH-mm-ss")
'Path of export
varExportPath = "C:\Users\Public\Downloads\"
'Check for terminating backslash ExportLinkReportsOut filepath.
If Right(varExportPath, 1) <> "\" Then
varExportPath = varExportPath & "\"
End If
varExportPath = varExportPath & strRptName & ".xlsx"
' set dao and create temp table
Dim cdb As DAO.Database, qdf As DAO.QueryDef
Const tempTableName = "_tempTbl"
Set cdb = CurrentDb
'deletes temp table and handles error
On Error Resume Next
DoCmd.DeleteObject acTable, tempTableName
On Error GoTo 0
Set qdf = cdb.CreateQueryDef("")
qdf.SQL = "SELECT * INTO [" & tempTableName & "] FROM [" & strRptSource & "] where filtercondition"
qdf.Execute
Set qdf = Nothing
Set cdb = Nothing
' export spreadsheet with the temp table, the export path, and then open the spreadsheet
DoCmd.TransferSpreadsheet acExport, , tempTableName, varExportPath, True
Set oExcel = GetObject(varExportPath)
oExcel.Application.Visible = True
oExcel.Parent.Windows(1).Visible = True
End Sub
Everything works when I change qdf.SQL = "SELECT * INTO [" & tempTableName & "] FROM [" & strRptSource & "] where filtercondition" to qdf.SQL = "SELECT * INTO [" & tempTableName & "] FROM [" & strRptSource & "] "
Problem is there is no filter when I drop filtercondition, obviously.
The error I keep getting is "Run-time error '3061': Too few paramters. Expected 1."
Anyone have any pointers?
The problem is that you aren't concatenating the filter condition. Your query just states WHERE filtercondition, not WHERE TxnDate >= #11/1/2017# AND TxnDate <= #11/30/2017#
Change qdf.SQL = "SELECT * INTO [" & tempTableName & "] FROM [" & strRptSource & "] where filtercondition" to qdf.SQL = "SELECT * INTO [" & tempTableName & "] FROM [" & strRptSource & "] WHERE " & filtercondition
rs2.FindFirst "[aniin] ='" & strTemp & "'"
aniin being an alias from the SQL within the function.
also tried ...
rs2.FindFirst (niin = newdata)
is my attempt to isolate the field name niin from the record value in the form from the one in the strSQL2. All my attempts have failed. I am trying to make sure that what the user typed in does match the list from the SQL string.
Private Function IsPartOfAEL(newdata) As Boolean
On Error GoTo ErrTrap
Dim db2 As DAO.Database
Dim rs2 As DAO.Recordset
Dim strTemp As String
strSQL2 = "SELECT tbl_ael_parts.master_ael_id, tbl_master_niin.niin as aniin " & vbCrLf & _
"FROM tbl_master_niin INNER JOIN tbl_ael_parts ON tbl_master_niin.master_niin_id = tbl_ael_parts.master_niin_id " & vbCrLf & _
"WHERE (((tbl_ael_parts.master_ael_id)= " & Forms!frm_qry_niin_local!master_ael_id & "));"
Set db2 = CurrentDb
Set rs2 = db2.OpenRecordset(strSQL2)
strTemp = newdata
If rs2.RecordCount <> 0 Then
rs2.FindFirst "[aniin] ='" & strTemp & "'"
If rs2.NoMatch Then
IsPartOfAEL = False
Else
IsPartOfAEL = True
End If
Else
MsgBox "Query Returned Zero Records", vbCritical
Exit Function
End If
rs.Close
Set rs2 = Nothing
Set db2 = Nothing
ExitHere:
Exit Function
ErrTrap:
MsgBox Err.description
Resume ExitHere
End Function
First: You should never include a constant like vbCrLf when building a query string. The query parser doesn't care if there's a linefeed, and in fact this can sometimes cause issues.
Your code seems to do nothing more that verify whether the value in newdata exists in the tbl_ael_parts and is associated with the value master_ael_id value currently showing on frm_qry_niin_local. If so, then just use DCount, or use this for your query:
strSQL2 = "SELECT tbl_ael_parts.master_ael_id INNER JOIN tbl_ael_parts ON
tbl_master_niin.master_niin_id = tbl_ael_parts.master_niin_id WHERE (((tbl_ael_parts.master_ael_id)=
" & Forms!frm_qry_niin_local!master_ael_id & ") AND niin=" & newdata & ");"
Dim rst As DAO.Recordset
Set rst = currentdb.OPenrecordset(strsql2)
If (rst.EOF and rst.BOF) Then
' no records returned
Else
' records found
End If
If niin is a Text field:
strSQL2 = "SELECT tbl_ael_parts.master_ael_id INNER JOIN tbl_ael_parts ON
tbl_master_niin.master_niin_id = tbl_ael_parts.master_niin_id WHERE (((tbl_ael_parts.master_ael_id)=
" & Forms!frm_qry_niin_local!master_ael_id & ") AND (niin='" & newdata & "'));"
If both niin and master_ael_id are Text fields:
strSQL2 = "SELECT tbl_ael_parts.master_ael_id INNER JOIN tbl_ael_parts ON
tbl_master_niin.master_niin_id = tbl_ael_parts.master_niin_id WHERE (((tbl_ael_parts.master_ael_id)=
'" & Forms!frm_qry_niin_local!master_ael_id & "') AND (niin='" & newdata & "'));"