I use this function for getting info from an text-file:
Function Import_Kundendaten_FromText(sqlstring As String) As String
'On Error GoTo MeinEnde
Dim cn As ADODB.connection
Dim rec As ADODB.Recordset
Set cn = New ADODB.connection
On Error Resume Next
cn.Open "Driver={Microsoft Text Driver (*.txt; *.csv)};" & _
"Dbq=" & "" & ";" & "Extensions=asc,csv,tab,txt;"
On Error GoTo 0
If cn.State <> adStateOpen Then Exit Function
On Error Resume Next
Set rec = New ADODB.Recordset
rec.Open LCase(sqlstring), cn, adOpenForwardOnly, adLockReadOnly, adCmdText
If Not rec.BOF And Not rec.EOF Then Import_Kundendaten_FromText = rec.Fields(0).Value '
MeinEnde:
If Err <> 0 Then fehlerverarbeitung ("Err-Nr: " & Err.Number & Chr(10) & "Err-Desc: " & Err.Description & Chr(10) & _
"Err-Source: " & Err.Source & Chr(10) & "Sub Import_Kundendaten_FromText" & Chr(10) & Now())
End Function
If I use this like
Import_Kundendaten_FromText("SELECT SOMETEXTFIELD FROM C:\variable_outl_kunden.txt WHERE CustNo = 105")
=> works perfect!
Import_Kundendaten_FromText("SELECT SOMETEXTFIELD FROM C:\variable_outl_kunden.txt WHERE CustName = 'Someone'")
=> does not give any results nor an error!!!
I have no idea, why I can not use text in the where-staement - any ideas?
Thanks!
Max
There is a number of problems with your code.
As mentioned in the comments, you need a Schema.ini file for your code to work. - I assume you have got one already because otherwise your code would only work if the text file matches the default settings of the Text Driver.
The On Error Resume Next statements, particularly the second one, in your code are most likely the reason why you do not see any error message.
The column names and data in the text file will be treated case sensitive. So your LCase(sqlstring) is not a good idea unless the text file content is all lower case.
I am working with vba, and I am using an excel sheet to find prices using SQL code within vba. Below is an example of how it is done:
Sub connection()
Set cn = New ADODB.connection
Set cn = CreateObject("ADODB.Connection")
With cn
.Provider = "Microsoft.ACE.OLEDB.12.0"
.ConnectionString = "Data Source=" & ThisWorkbook.Path & "\" & ThisWorkbook.Name & ";" & _
"Extended Properties=""Excel 12.0 Xml;HDR=YES"";"
.Open
End With
End Sub
Function getAddres(ByVal sTableName As String) As String
With Range(sTableName & "[#All]")
getAddres = "[" & .Parent.Name & "$" & .Address(False, False) & "]"
End With
End Function
Function Get_Coeff_1_crit(couv As String, tabelle As String, edit As String, crit1 As String) As Variant
Dim NomFeuille As String, texte_SQL As String
Dim rst As ADODB.Recordset
Dim strRangeAddress As String
Call connection
strRangeAddress = getAddres(edit)
texte_SQL = "SELECT [Coeff] FROM " & strRangeAddress & " WHERE ([Tabelle]=" & Chr(34) & tabelle & Chr(34) & _
" ) AND (( [Booléen_1] = " & crit1 & " ) OR ( [Fixe_1] = " & crit1 & " ) OR (" & crit1 & " BETWEEN [Min_1] AND [Max_1] ))"
Set rst = New ADODB.Recordset
Set rst = cn.Execute(texte_SQL)
On Error Resume Next
Get_Coeff_1_crit = 0
Get_Coeff_1_crit = rst.Fields(0).Value 'ws.Range("N7").CopyFromRecordset Rst
End Function
So I have an input of variables and this function looks for the table and correct variable combination.
My issue is that with many functions each establishing a separate connection with the excel sheet, it takes an insane amount of time to process a lot of prices.
I was wondering if anyone knows of a better way, I am rather new at vba, so I was wondering if we can store dataframes within the process like in python or is there a different way to not establish connections each time.
Thanks.
if you're looping over Get_Coeff_1_crit repeatedly then I can see why it's bogging down while it's reestablishing that connection each pass.
You'd want to do something like this inside the function,
If Not cn is Nothing then 'verify the object is instantiated
If cn.State = adStateClosed then 'State property tells if it's open
Call Connection
End If
End If
'further details on that property - https://www.w3schools.com/asp/prop_comm_state.asp
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"
Getting the "Query too complex" VBA error when trying to run the below code and can't quite seem to figure out why?
Public Sub Update9MonthsDB(ByVal colSelection As Collection)
Dim rs As ADODB.Recordset
Dim strSQL As String
Call Open_Conn(strDb)
Set rs = New ADODB.Recordset
rs.ActiveConnection = CON
rs.CursorType = adOpenKeyset
rs.CursorLocation = adUseClient
rs.LockType = adLockBatchOptimistic
rs.Open ("Select * From [PortfolioDB$]")
For Each Item In colSelection
strSQL = "Grid_Ref='" & Item & "'"
rs.Find strSQL
Debug.Print rs!Grid_Ref
rs("MonthCheck9") = "1"
Debug.Print rs!MonthCheck9
Next Item
rs.UpdateBatch
rs.Close
Call Close_Conn
End Sub
My connection string is used elsewhere in the code and is working fine for normal update/select etc statements. My debug prints show that the collection is not empty and returns the correct value with the other debug value check. But as soon as it gets to rs.UpdateBatch, it crashes out to "Query too complex" error.
EDIT: Just to clarify sorry, this is updating an excel spreadsheet acting as a database (back end)
EDIT: Connection string below as requested in comments.
Sub Open_Conn(strDb As String)
On Error GoTo conError
Debug.Print (Time() & " - Connecting to: " & strDb)
Set CON = New ADODB.Connection
CON.Provider = "Microsoft.ACE.OLEDB.12.0"
CON.Open "Data Source=" & strDb & ";" & _
"Extended Properties=""Excel 12.0 XML;HDR=Yes"""
Debug.Print (Time() & " - Connected")
Exit Sub
conError:
logevents ("There was an error processing the connection: " & strSQL & _
vbNewLine & vbTab & vbTab & vbTab & vbTab & Error(Err))
Resume Next
End Sub
In a nutshell: I'm making a scheduler for my client and, due to constraints, it needs to be in a single excel file (as small as possible). So one worksheet works as the UI and any others will be tables or settings.
I'm trying to use SQL (to which I'm new) to work with the schedule data on a single worksheet (named "TblEmpDays"). So I need to add/update and retrieve records to/from this worksheet. I was able to get a SELECT query to work with some arbitrary data (and paste to a Range). However, I'm not able to get INSERT or UPDATE to work. I've seen it structured as INSERT INTO [<table name>$] (<field names>) VALUES (<data>);. However this gives me a run-time error "'-2147217900 (80040e14)' Syntax error in INSERT INTO statement."
I'm using VBA to write all of this and I made an SQL helper class to make the query execution easier.
To clarify, my question is: How do I need to construct the INSERT and UPDATE queries? What am I missing? I'm trying to post as much related info as possible, so let me know if I missed anything.
Class SQL:
Private pCn ' As Database
Private pResult 'As Recordset
Private pSqlStr As String
Public Property Get Result()
Result = pResult
End Property
Public Function Init()
Set pCn = CreateObject("ADODB.Connection")
With pCn
.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & ThisWorkbook.FullName & ";" & _
"Extended Properties=""Excel 12.0 Macro;HDR=YES;ReadOnly=False"";"
.Open
End With
End Function
Public Function Cleanup()
If Not (pCn Is Nothing) Then
pCn.Close
Set pCn = Nothing
End If
If Not pResult Is Nothing Then
Set pResult = Nothing
End If
End Function
Public Function CopyResultToRange(rg As Range)
If Not rg Is Nothing And Not pResult Is Nothing Then
rg.CopyFromRecordset pResult
End If
End Function
Public Property Get query() As String
query = pSqlStr
End Property
Public Property Let query(value As String)
pSqlStr = value
End Property
Public Function Execute(Optional sqlQuery As String)
If sqlQuery = "" Then
sqlQuery = query
End If
If Not pCn Is Nothing Then
Set pResult = pCn.Execute(sqlQuery, , CommandTypeEnum.adCmdText Or ExecuteOptionEnum.adExecuteNoRecords)
Else
MsgBox "SQL connection not established"
End If
End Function
Executing function:
Dim s As SQL ' this is the SQL class '
Dim tbl As String
' rcDay=date string, rcIn & rcOut = time strings, rcVac=boolean string, rcSls=number string'
Dim rcName As String, rcDay As String, rcIn As String, rcOut As String, rcVac As String, rcSls As String
Dim qry As String
tbl = "[TblEmpDays$]"
qry = "INSERT INTO <tbl> (name, date, in, out, vac, sales)" & vbNewLine & _
"VALUES ('<name>', '<date>', '<in>', '<out>', '<vac>', <sales>);"
' Set rc* vars '
s.Init
s.query = Replace(Replace(Replace(Replace(Replace(Replace(Replace(qry, _
"<tbl>", tbl), _
"<sales>", rcSls), _
"<vac>", rcVac), _
"<out>", rcOut), _
"<in>", rcIn), _
"<date>", rcDay), _
"<name>", rcName)
MsgBox s.query
s.Execute
s.Cleanup
I've looked all over an can't find a solution. I'm sure I just haven't searched the right phrase or something simple.
I'm posting the solution here since I can't mark his comment as the answer.
Thanks to #Jeeped in the comments, I now feel like an idiot. It turns out three of my field names were using reserved words ("name", "date", and "in"). It always seems to be a subtle detail that does me in...
I renamed these fields in my worksheet (table) and altered the appropriate code. I also had to Cast the input strings into the proper data types. I'm still working the rest of the details out, but here's the new query:
qry = "INSERT INTO <tbl> (empName, empDay, inTime, outTime, vac, sales)" & vbNewLine & _
"VALUES (CStr('<name>'), CDate('<date>'), CDate('<in>'), CDate('<out>'), " & _
"CBool('<vac>'), CDbl(<sales>));"
I needed the CDate() (instead of the #*#) so I could pass in a string.
So CDate('<date>') instead of #<date>#
Consider using a relational database as backend instead of a worksheet for your project. You can continue to use the UI spreadsheet as a frontend. As a Windows product, the Jet/ACE SQL Engine can be a working solution plus it allows multiple user with simultaneous access (with record-level locking). Additionally, Jet/ACE comes equipped with its own SQL dialect for Database Definition Language (DDL) and Database Maniupulation Language (DML) procedures. And Excel can connect to Jet/ACE via ADO/DAO objects. The only difference of Jet/ACE compared to other RDMS is that it is a file level database (not server) and you cannot create a database using SQL. You must first create the database file using VBA or other COM defined language.
Below are working examples of VBA scripts (Clients and Orders tables) in creating a database with DAO, creating tables with ADO, executing action queries, and copying a recordset to worksheet. Integrate these macros into your project. Use error handling and debug.Print to help develop your app. If you do not have MS Access installed, the .accdb file will show in directory but with blank icon. There will be no user interface to manage the file except via code.
Sub CreateDatabase()
On Error GoTo ErrHandle
Dim fso As Object
Dim olDb As Object, db As Object
Dim strpath As String
Const dbLangGeneral = ";LANGID=0x0409;CP=1252;COUNTRY=0"
strpath = "C:\Path\To\Database\File.accdb"
' CREATE DATABASE '
Set fso = CreateObject("Scripting.FileSystemObject")
Set olDb = CreateObject("DAO.DBEngine.120")
If Not fso.FileExists(strpath) Then
Set db = olDb.CreateDatabase(strpath, dbLangGeneral)
End If
Set db = Nothing
Set olDb = Nothing
Set fso = Nothing
MsgBox "Successfully created database!", vbInformation
Exit Sub
ErrHandle:
MsgBox Err.Number & " - " & Err.Description, vbCritical
Exit Sub
End Sub
Sub CreateTables()
On Error GoTo ErrHandle
Dim strpath As String, constr As String
Dim objAccess As Object
Dim conn As Object
strpath = "C:\Path\To\Database\File.accdb"
' CONNECT TO DATABASE '
constr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strpath & ";"
Set conn = CreateObject("ADODB.Connection")
conn.Open constr
' CREATE TABLES (RUN ONLY ONCE) '
conn.Execute "CREATE TABLE Clients (" _
& " ClientID AUTOINCREMENT," _
& " ClientName TEXT(255)," _
& " Address TEXT(255)," _
& " Notes TEXT(255)," _
& " DateCreated DATETIME" _
& ");"
conn.Execute "CREATE TABLE Orders (" _
& " OrderID AUTOINCREMENT," _
& " ClientID INTEGER," _
& " Item TEXT(255)," _
& " Price DOUBLE," _
& " OrderDate DATETIME," _
& " Notes TEXT(255)" _
& ");"
' CLOSE CONNECTION '
conn.Close
Set conn = Nothing
MsgBox "Successfully created Clients and Orders tables!", vbInformation
Exit Sub
ErrHandle:
MsgBox Err.Number & " - " & Err.Description, vbCritical
Exit Sub
End Sub
Sub RetrieveDataToWorksheet()
On Error GoTo ErrHandle
Dim strpath As String, constr As String
Dim conn As Object, rs As Object
Dim fld As Variant
strpath = "C:\Path\To\Database\File.accdb"
' OPEN CONNECTION '
constr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strpath & ";"
Set conn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
conn.Open constr
rs.Open "SELECT * FROM Clients" _
& " INNER JOIN Orders ON Clients.ClientID = Orders.ClientID;", conn
' COPY FROM RECORDSET TO WORKSHEET '
Worksheets(1).Activate
Worksheets(1).Range("A4").Select
' COLUMN NAMES '
For Each fld In rs.Fields
ActiveCell = fld.Name
ActiveCell.Offset(0, 1).Select
Next
' ROW VALUES '
Worksheets(1).Range("A5").CopyFromRecordset rs
' CLOSE RECORDSET AND CONNECTION '
rs.Close
conn.Close
Set conn = Nothing
Set rs = Nothing
Exit Sub
ErrHandle:
MsgBox Err.Number & " - " & Err.Description, vbCritical
Exit Sub
End Sub
Sub ActionQueries()
On Error GoTo ErrHandle
Dim strpath As String, constr As String
Dim conn As Object
strpath = "C:\Path\To\Database\File.accdb"
' OPEN CONNECTION '
constr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & strpath & ";"
Set conn = CreateObject("ADODB.Connection")
conn.Open constr
' APPEND QUERY '
conn.Execute "INSERT INTO Clients (ClientID, ClientName)" _
& " VALUES (" & Worksheets(1).Range("A2") & ", '" & Worksheets(1).Range("B2") & "');"
conn.Execute "INSERT INTO Orders (ClientID, Item, Price)" _
& " VALUES (" & Worksheets(1).Range("A2") & ", " _
& "'" & Worksheets(1).Range("C2") & "', " _
& Worksheets(1).Range("D2") & ");"
' UPDATE QUERY '
conn.Execute "UPDATE Clients " _
& " SET Address = '" & Worksheets(1).Range("E2") & "'" _
& " WHERE ClientID = " & Worksheets(1).Range("A2") & ";"
' DELETE QUERY '
conn.Execute "DELETE FROM Orders " _
& " WHERE ClientID = " & Worksheets(1).Range("A2") & ";"
' CLOSE CONNECTION '
conn.Close
Set conn = Nothing
MsgBox "Successfully updated database!", vbInformation
Exit Sub
ErrHandle:
MsgBox Err.Number & " - " & Err.Description, vbCritical
Exit Sub
End Sub