VBA to query field contents in CSV - vba

I'm struggling with ADO connections/recordsets.
My problem statement is: a function that will return the first value of a chosen field, in a chosen .csv file.
I am doing this to identify variably-named .csv files before adding the data to the relevant tables in a database. I am making the assumption that this field is always present and that either it is consistent throughout the file, or only relevant ones are grouped (this is controlled higher up the chain and is certain enough).
My code is being run as part of a module in an MS Access database:
Public Function GetFirstItem(File As Scripting.File, Field As String)
Dim Conn As ADODB.Connection, Recordset As ADODB.Recordset, SQL As String
Set Conn = New ADODB.Connection
Set Recordset = New ADODB.Recordset
'Microsoft.ACE.OLEDB.16.0 / Microsoft.Jet.OLEDB.4.0
Conn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.16.0;Data Source=""" & File.ParentFolder & _
"""; Extended Properties=""text;HDR=Yes;FMT=Delimited;"";"
SQL = "SELECT " & Field & " FROM """ & File.Name & """ LIMIT 1"
Debug.Print Conn.ConnectionString
Debug.Print SQL
Conn.Open
Recordset.Source = SQL
Recordset.ActiveConnection = Conn.ConnectionString
Recordset.Open
Recordset.MoveFirst
'GetFirstItem = Recordset!Questionnaire
Recordset.Close
Conn.Close
Set Recordset = Nothing
Set Conn = Nothing
End Function
ConnectionString = Provider=Microsoft.ACE.OLEDB.16.0;Data Source="D:\Documents\Jobs\TestPath"; Extended Properties="text;HDR=Yes;FMT=Delimited;";
Field = Questionnaire
SQL = SELECT Questionnaire FROM "test.csv" LIMIT 1
I get an error on Recordset.Open of:
This may be (is probably) down to a complete lack of understanding of how ADO connections/recordsets work. I have tried sans-quotes and it complains about a malformed FROM expression. Additionally, once this hurdle is overcome I am unsure of the syntax of how to return the result of my query. If there is a better way of doing this I am all ears!
Thanks.

In Access you don't need ADO library to query a CSV file:
Public Function GetFirstItem(File As Scripting.File, Field As String) As String
Dim RS As DAO.Recordset, SQL As String
SQL = "SELECT TOP 1 [" & Field & "]" _
& " FROM [" & File.Name & "]" _
& " IN '" & File.ParentFolder & "'[Text;FMT=CSVDelimited;HDR=Yes];"
Debug.Print SQL
Set RS = CurrentDb.OpenRecordset(SQL)
GetFirstItem = RS(0)
RS.Close
Set RS = Nothing
End Function
Usage:
?GetFirstItem(CreateObject("Scripting.FileSystemObject").getfile("c:\path\to\your\file.csv"), "your field")

Related

Automation Error when Attempting to Query Access Database Using VBA

I've made the following ADODB object declarations in code.
Dim OConn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim fld As ADODB.Field
Set OConn = New ADODB.Connection
Set rs = New ADODB.Recordset
I would like to use the following code to read from a table on a MS Access database file and generate a recordset, rs.
'Get the table name from the search results.
tableName = ThisWorkbook.Sheets("PLC Module Data").Cells(2, 9).Value
'Set the SQL string.
strSql = "SELECT Code, Points, Type, Description, Rating " & _
"FROM " & tableName
'Set the connection string and open the connection to the Access DB.
OConn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=Q:\AutoCAD Improvements\PLC IO Utility Docs\PLC IO Spreadsheet
App\PLC IO App\ace_plc.mdb"
OConn.Open
'Open the recordset and error out if nothing is returned
Set rs = OConn.Execute(strSql)
If rs.EOF Then
MsgBox "No matching records found."
rs.Close
OConn.Close
Exit Sub
End If
I've checked the query statement within the Access file itself and it works fine. I always get the error
Run-time error'-2147217900 (80040e14)': Automation Error
on the line,
Set rs = OConn.Execute(strSql)
If anyone could take a look over my code and determine why this is happening it would be much appreciated. I've looked at similar examples online and it seems like this should be correct.
I added the brackets around the tableName string and it works now. Thanks for all the feedback.
'Set the SQL string.
strSql = "SELECT Code, Points, Type, Description, Rating " & _
"FROM [" & tableName & "]"

SQL Select Statement in Microsoft Access VBA - Need help inserting in Access table as block, not loop

I am trying to do a Select statement from an SQL server using an ADODB connection, within Microsoft Access VBA. The select statement is very complex with calculations and would work better to keep that to try and turn in to a connection with the DB.
I can append the data row by row, but am wondering how I could append as simple as possible as a block of data to save time/vba effort. (Lots of data!)
In order to simplify the example, I have put a basic SQL statement, but if you could review this and let me know if there is a way to append as a recordset block or what would be a better option... The code below works for pasting as a block into excel, and I would think I only need to change that commented out line's method to append in Access...
Option Private Module
Private Const DataServer = "GLSSQLMADPS2"
Private Const sqlconstring = "Driver={SQL Server};Server=" & DataServer & "; Database=PERF_MGMT_BWRSRV_PROD; Trusted_Connection=yes; Connect Timeout = 600"
Sub M2DSQLPull()
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim sql As String
Dim sql As String
sql = "SELECT " & _
"Employee_Token_NR, " & _
"Null as 'Sum_Month', " & _
"1000 AS 'Data_ID', " & _
"DATEADD(m, DATEDIFF(m, 0, MIN(CALL_TS)), 0) AS 'Metric_1' " & _
"FROM PMBSED_PhoneEvaluations " & _
"GROUP BY Employee_Token_NR "
Set cn = New ADODB.Connection
cn.CommandTimeout = 120
cn.Open sqlconstring
Set rs = New ADODB.Recordset
rs.Open SqlString(i), cn, adOpenStatic, adLockReadOnly
'How I would paste in an excel spreadsheet, how do I block paste in an access database?
'ThisWorkbook.Worksheets("RawData").Cells(RowNumber, 1).CopyFromRecordset rs
RowNumber = RowNumber + rs.RecordCount
rs.Close
cn.Close
End Sub
Thank you for any assistance!
-Robert

Performing SQL queries on basic Excel 2013 worksheet as table using ADO with VBA triggers Errors

I'm developping modules on a client XLSm with 32-bits 2013 Excel.
I'd like to use datas on worksheet as if it is an Access table.
With a lot of difficulties, I think connection is now OK.
Still, I have error : 3001 Arguments are of wrong type, are out of acceptable range. Error that I cannot understand.
Here excerpts of VBA lines :
In addition, I added 20 lines in data Worksheet below the header line to permit to Excel to interpret for the type of each columns.
varCnxStr = "Data Source=" & G_sWBookREINVOICingFilePath & ";" & "Extended Properties='Excel 12.0 Xml;HDR=YES;IMEX=15';"
With conXLdb
.Provider = "Microsoft.ACE.OLEDB.12.0"
.Mode = adModeShareExclusive
.Open varCnxStr
End With
strSQL = "SELECT * "
strSQL = strSQL & " FROM [ReInvoiceDB$B2B5072] inum "
strSQL = strSQL & " WHERE inum.InvoiceNum LIKE '1712*' "
strSQL = strSQL & ";"
'>> TRIGGERs ERROR with the current Where Clause !!'
adoXLrst.Open strSQL, conXLdb, dbOpenDynamic, adLockReadOnly, adCmdText
If adoXLrst.BOF And adoXLrst.EOF Then
'no records returned'
GoTo Veloma
End If
adoXLrst.MoveFirst
Do While Not adoXLrst.EOF
'Doing stuff with row'
adoXLrst.MoveNext
Loop
sHighestSoFar = adoXLrst(1).Value '> just to try for RecordSet : Codes are not completed...
sPrefixeCURR = Mid(sHighestSoFar, 1, 4)
Highest = CInt(Mid(sHighestSoFar, 5))
'> Increment >'
Highest = Highest + 1
HighestStr = sPrefixeCURR & Format(Highest, "00")
strGSFNumber = HighestStr
adoXLrst.Close
conXLdb.Close
Veloma:
On Error Resume Next
Set adoXLrst = Nothing
Set conXLdb = Nothing
Exit Sub
Etc.
Any idea about what seems be wrong ?
Thank you
Below is an old example I have been using successfully. Note that the sheet name in the book are Sheet1 and Sheet2, but in the query I had to use sheet1$ and sheet2$. I noticed you had $ signs in the middle of your sheet names. perhaps that's the issue ?
Sub SQLUpdateExample()
Dim con As ADODB.Connection
Dim rs As ADODB.Recordset
Set con = New ADODB.Connection
con.Open "Driver={Microsoft Excel Driver (*.xls)};" & _
"DriverId=790;" & _
"Dbq=" & ThisWorkbook.FullName & ";" & _
"DefaultDir=" & ThisWorkbook.FullName & ";ReadOnly=False;"
Set rs = New ADODB.Recordset
Set rs = con.Execute("UPDATE [Sheet1$] inner join [Sheet2$] on [Sheet1$].test1 = [Sheet2$].test1 SET [Sheet1$].test3 = [Sheet2$].test2 ")
Set rs = Nothing
Set con = Nothing
End Sub
To give more details about the whole module to be implemented : it is to perform a Transaction unit.
This transaction will comprise 3 operations : get a max value from a column (Invoice number) to increment it, record the new number inside an Access table (by DAO), the same Excel file (by ADO) and generating document on HDD.
So it is aimed to use the Excel file as a table not as a file manipulated with Windows script or Excel VBA. My end user is disturbed by the pop-uping of an Excel opening file operation. As a developer, I'm feeling more comfortable with using SQL statements as much as possible inside Transaction session. Is that your opinion too ?

How to export SQL statement results to an Excel File

I have an Access DataBase and a form in Excel VBA. All the data I input into the DB is input through the VBA form.
This DB contains all the benefits cards we already received this year in the company. But the same employee can ask for the card twice or more, so we'll have more than one record on the DB for him.
What I need is when the number of records is greater than one, the SQL statement result should appear in a Excel report.
I use the SELECT (*) COUNT statement to know when there is more than one record that is compatible with the search criterion. But I can't make the result appear in an Excel file.
Here is my code:
Public Function Relatorio()
Dim sql As String
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim rel As String
Set cn = New ADODB.Connection
cn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & enderecoDB & ";Jet OLEDB:Database"
cn.Open
Set rs = New ADODB.Recordset
sql = "INSERT INTO OPENROWSET('Microsoft.ACE.OLEDB.12.0', 'Excel 12.0;Database=" & enderecoDB & ";', 'SELECT * FROM [Planilha1$]') SELECT * FROM controle WHERE BP = " & controlectform.nmbpbox.Value & ";"
rs.Open sql, cn
End Function
When I run this code it gives me a message saying something like:
Can't locate the OPENROWSET Table exit
I'm not able to install new programs, so I need to do this using only Excel VBA and the Access DB.
How can I make this work?
I don't believe Access supports the OPENROWSET, dynamic table you're working with there. I have a lot of old projects that do this though, so here's my method
Public Function Relatorio()
Dim sql As String
Dim cn As ADODB.Connection
Dim rs As ADODB.Recordset
Dim rel As String
Set cn = New ADODB.Connection
cn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & enderecoDB & ";Jet OLEDB:Database"
cn.Open
Set rs = New ADODB.Recordset
dim path_To_XLSX
dim name_of_sheet
path_To_XLSX = "c:\temp\output.xlsx"
name_of_sheet = "Planilha1"
sql = sql = "SELECT * INTO [Excel 12.0;Database=" & path_To_XLSX & "]." & name_of_sheet & " FROM controle WHERE BP = '" & controlectform.nmbpbox.Value & "';"
rs.Open sql, cn
'If this application is in an unsecure environment, use the following code instead! This is to prevent a SQL injection, security concern here.
'As it is an Access Database, this is likely overkill for this project
'Create Command Object.
Set Cmd1 = New ADODB.Command
Cmd1.ActiveConnection = cn
cmd1.CommandText = "SELECT * FROM controle INTO [Excel 12.0;Database=" & path_To_XLSX & "]." & name_of_sheet & " WHERE BP = ?"
' Create Parameter Object.
Set Param1 = Cmd1.CreateParameter(, adInteger, adParamInput, 5) 'use adVarchar for strings(versus adInteger), https://www.w3schools.com/asp/met_comm_createparameter.asp
Param1.Value = controlectform.nmbpbox.Value
Cmd1.Parameters.Append Param1
Set Param1 = Nothing
Set Rs = Cmd1.Execute()
End Function
I had this challenge so many years ago that I cant remember but this link ring the bell. check if it help.
https://stackoverflow.com/a/28889774/382588
try { connw.Open(); OleDbCommand command; command = new OleDbCommand( "Update Deliveries " + "SET Deliveries.EmployeeID = ?, Deliveries.FIN = ?, Deliveries.TodaysOrders = ? , connw); command.Parameters.Add(new OleDbParameter("#EMPID", Convert.ToDecimal(empsplitIt[1]))); command.Parameters.Add(new OleDbParameter("#FIN", truckSplit[1].ToString())); command.Parameters.Add(new OleDbParameter("#TodaysOrder", "R")); catchReturnedRows = command.ExecuteNonQuery();//Commit connw.Close(); } catch (OleDbException exception) { MessageBox.Show(exception.Message, "OleDb Exception"); }
you can use this, to print the actual SQL.
Private Sub Command2_Click()
Dim db As Database
Dim qr As QueryDef
Set db = CurrentDb
For Each qr In db.QueryDefs
TextOut (qr.Name)
TextOut (qr.SQL)
TextOut (String(100, "-"))
Next
End Sub
Public Sub TextOut(OutputString As String)
Dim fh As Long
fh = FreeFile
Open "C:\Users\rs17746\Desktop\Text_Files\sample.txt" For Append As fh
Print #fh, OutputString
Close fh
End Sub
Here is one more version for you. This will export the results of each query, each to a separate text file.
Private Sub Command0_Click()
Dim qdf As QueryDef
Dim strFileName As String
For Each qdf In CurrentDb.QueryDefs
If Left(qdf.Name, 1) <> "~" Then
'you need to figure out TransferText command. Maybe
'you won't be lazy and expect people to read it to
'you and tutor you on how it works.
strFileName = qdf.Name
'Docmd.TransferText ....
DoCmd.TransferText transferType:=acExportDelim, TableName:=strFileName, FileName:="C:\test\" & strFileName & ".txt", hasfieldnames:=True
End If
Next qdf
MsgBox "Done"
End Sub

T-SQL query with variable declarations in Excel VBA Code fail

I got a problem with running SQL query with "declare" and "set" functions in VBA.
Sheets("Arkusz1").Select
connstring = _
"ODBC;DRIVER=SQL Server;SERVER=my_database_server;UID=user;PWD=password;APP=Microsoft Office 2010;WSID=some_id;DATABASE=mydatabase"
With ActiveSheet.QueryTables.Add(Connection:=connstring, Destination:=Worksheets("Arkusz1").Range("A1"), Sql:=Array( _
"declare #dzisiaj date" & Chr(13), _
"set #dzisiaj = getdate()" & Chr(13), _
"select #dzisiaj as dzisiaj"))
.BackgroundQuery = False
.Refresh
End With
In SQL Server 2012 that code works fine, but... when I embed it into it gives me a run-time error '1004'. Also VBA code works on other queries works well.
My full SQL query has about 90 lines with 2 variable declarations (one declaration is a value from another 30 line SQL query), so it's mandatory to include variable declarations :)
How to solve that problem?
I figured it out. The key is to use ADODB connection to import data via SQL Query. Also necessary is to check Microsoft Active X Data Objects 2.0 library in Tools->References in Visual Basic Editor (Shortcut: Alt+F11 in Excel).
So, there is an example of my VBA code:
Sub sql_query_import()
' Declarations
Dim Cn As ADODB.Connection
Dim Server_Name As String
Dim Database_Name As String
Dim User_ID As String
Dim Password As String
Dim SQLStr As String
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
' Server connection settings
Server_Name = "192.168.1.106\my_database" ' IP of server name
Database_Name = "mydatabase" ' Database name
User_ID = "myusername" ' User name
Password = "mypassword" ' User password
' SQL Query
SQLStr = "SET NOCOUNT ON " & Chr(13) ' it's mandatory if you don't want to get error 3704
SQLStr = SQLStr & "declare #dzisiaj date " & Chr(13)
SQLStr = SQLStr & "set #dzisiaj = getdate() " & Chr(13)
SQLStr = SQLStr & "select #dzisiaj as 'today'
' Connect to database
Set Cn = New ADODB.Connection
Cn.Open "Driver={SQL Server};Server=" & Server_Name & ";Database=" & Database_Name & _
";Uid=" & User_ID & ";Pwd=" & Password & ";"
' Start connection
rs.Open SQLStr, Cn, adOpenStatic
' Load data
With rs
For i = 1 To .Fields.Count
Worksheets(1).Cells(1, i) = .Fields(i - 1).Name ' Include column name if not - delete it
Next i
End With
Worksheets(1).Cells(2, 1).CopyFromRecordset rs ' Start loading data to Cell A2
rs.Close
Set rs = Nothing
Cn.Close
Set Cn = Nothing
End Sub
Using in SQL Query "SET NOCOUNT ON" is necessary if you don't want to get error 3704.
Also, using
SQLStr = "SET NOCOUNT ON " & Chr(13) ' it's mandatory if you don't want to get error 3704
SQLStr = SQLStr & "declare #dzisiaj date " & Chr(13)
is more efficient way to include multi-line SQL Queries :)
I'm still new to vb and vba and learning myself, but I know you can declare and write to variables in VB.net which can then feed into an embedded SQL script. I would think you can do the same thing in vba. Here's what I suggest.
Declare a vb string like SQL_Var_1
Insert the 30-line SQL query as a separate query before the main query.
Write the result of the 30-line query to the vb string SQL_Var_1.
Remove the declarations from the Main SQL query but leaving the references to those variables.
Reference SQL_Var_1 as an input parameter in the embedded main query using the exact same name you used in the main query (i.e., #dzisiaj), like here.
If you follow these steps for both SQL variables, you should be able to achieve the same result as if you were using the declared SQL variables.