VBA, Import CSV split by ";" to sheet - vba

I am trying to import a CSV file split by semicolon ";" into an excel object so I can use it later on.
Ideally i would like to use ADO, DAO or ADODB so I can also run SQL queries on the object, and get sum of specific fields, or total number of fields and so on.
So far i've gotten the code below, but it does not split the data by ";", so it all comes back as 1 field instead of multiple fields that can be handled.
Sub Import()
Dim conn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim f As ADODB.Field
Dim csvName, csvPath
csvPath = ActiveWorkbook.path
csvName = "fileName.csv"
conn.Open "DRIVER={Microsoft Text Driver (*.txt; *.csv)};DBQ=" & csvPath & ";"
rs.Open "SELECT * FROM " & csvName, conn, adOpenStatic, adLockReadOnly, adCmdText
Debug.Print rs.Fields
While Not rs.EOF
For Each f In rs.Fields
Debug.Print f.Name & "=" & f.Value
Next
Wend
End Sub
Can anyone give me an idea how I can also split the data by ";" and query it using SQL query? Or a different object that I could load a CSV into and query certain columns.

Here's example:
Public Sub QueryTextFile()
Dim rsData As ADODB.Recordset
Dim sConnect As String
Dim sSQL As String
' Create the connection string.
sConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=C:\Files\;" & _
"Extended Properties=Text;"
' Create the SQL statement.
sSQL = "SELECT * FROM Sales.csv;"
Set rsData = New ADODB.Recordset
rsData.Open sSQL, sConnect, adOpenForwardOnly, _
adLockReadOnly, adCmdText
' Check to make sure we received data.
If Not rsData.EOF Then
' Dump the returned data onto Sheet1.
Sheet1.Range("A1").CopyFromRecordset rsData
Else
MsgBox "No records returned.", vbCritical
End If
' Clean up our Recordset object.
rsData.Close
Set rsData = Nothing
End Sub

The only answer I found that was usable was to create an ini file in the current folder, and enter the delimiter in the ini file.
iniPath = activeworkbook.path & "\"
iniName = "schema.ini"
iniPathName = iniPath & iniName
If Not fso.FileExists(iniPathName) Then
fso.CreateTextFile (iniPathName)
End if

Related

Running a SQL query in excel usin VBA

I am trying to create a macro that pulls data from a user-chosen workbook.
What I need is: 1) prompt user to choose which file they want to use 2) [Assuming a "Data" sheet always exists and has the same format] select * from Data worksheet where a condition is met 3) Output this in my excel file
My code is
Sub ConnectionToExcel()
Dim rstResult As ADODB.Recordset
Dim strConnectin As String
Dim strPath As String
Dim strSQL As String
strPath = Application.GetOpenFilename
strConnectin = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source='" & strPath & "';Extended Properties=""Excel 12.0 XML;HDR=YES;IMEX=0"" "
Debug.Print strConnectin
strSQL = "SELECT * FROM [Data$] "
Set rstResult = New ADODB.Recordset
rstResult.Open strSQL, strConnectin
'adOpenForwardOnly , adLockReadOnly, adCmdText
Sheets("Export").Range("A2").CopyFromRecordset rstResult
End Sub
I am not sure how to add the condition in the select statement. The condition would be to select the items based on a given value in one of the cols. So for example, Select * from table where Product=Banana"
ID Product
14243 Apple
43543 Banana
43432 Banana
Thanks
I tried a couple of if statements,
if worksheets(Data).range("A1:A220000")="Condition" then
strSQL = "SELECT * FROM [Data$] "
end if
I also tried adding a where clause in the select statement but doesn't seem to work either
You can try this, using Data$.Product='Banana' as WHERE clause.
Sub ConnectionToExcel()
Dim rstResult As ADODB.Recordset
Dim strConnectin As String
Dim strPath As String
Dim strSQL As String
strPath = Application.GetOpenFilename
strConnectin = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source='" & strPath & "';Extended Properties=""Excel 12.0 XML;HDR=YES;IMEX=0"" "
Debug.Print strConnectin
strSQL = "SELECT * FROM [Data$] WHERE (Data$.Product='Banana')"
Set rstResult = New ADODB.Recordset
rstResult.Open strSQL, strConnectin
'adOpenForwardOnly , adLockReadOnly, adCmdText
Sheets("Export").Range("A2").CopyFromRecordset rstResult
End Sub

VBA SQL Query only returns numeric values

I have a program designed to re-transcribe a text file into MS Excel using a VBA macro with an SQL query using ADODB.
The text file is itself an extract from a database from another department(and is presented as a comma separated table in the text file).
Anyway, I have a column ('Group' below) filed with either 'Z4' or '50'. These are the only two types of input for said column.
Until today, the query returned both values. Now, I only get '50'. The cells where 'Z4' ought to appear are empty.
Code is below:
Sub TextReader()
'Text reader
Application.ScreenUpdating = False
'Error Management
On Error Resume Next
'--------- Connection -------------------------------
Dim cnn As ADODB.Connection
Dim str As String
Set cnn = New ADODB.Connection
cnn.Provider = "Microsoft.ACE.OLEDB.12.0" '
cnn.ConnectionString = "Data Source=" & ThisWorkbook.Path & "\" & ";" & _
"Extended Properties=""text; HDR=YES; FMT=Delimited;"""
'Open Connection
cnn.Open
'ADODB record
Dim rs As ADODB.Recordset
Set rs = New ADODB.Recordset
'cleanup
Sheets("Cost").Cells.Clear
'SQL String
str = "select Group from ZR46.txt "
'Get the values
With rs
.ActiveConnection = cnn
.Open str
Sheets("Cost").Range("A2").CopyFromRecordset rs
.Close
End With
'Close
cnn.Close
Application.ScreenUpdating = True
End Sub
The text file (not exactly that, but modified because it's private data):
,Article,Designation,Price,Strat,Group,Provis,
,123456789,BODY,706§09,PD,Z4,COND,
,897654321,BONNET,1§456§15,PD,Z4,COND,
,123789456,STEM,102§06,PD,50,COND,

Saving Results of Access Query To Worksheet Excel VBA

I cant seem to find an easy way of doing outside of just accessing the SQL from ACCESS SQL View and doing it manually. Is there some magic way to use this code below and do that?
Its worth pointing out that I am trying to do this from Excel's VBA.
Private Sub tryagain()
Dim con As ADODB.Connection
Dim rs As ADODB.Recordset
Set con = New ADODB.Connection
With con
.Provider = "Microsoft.ACE.OLEDB.12.0"
.Open "C:\Users\Ashleysaurus\Desktop" & "\" & "xyzmanu3.accdb"
End With
con.Execute "Invoice Query"
'How do output to Worksheet?
rs.Close
cmd.ActiveConnection.Close
End Sub
Simply use the ADO recordset object which you initialize, call the query, and then run the Range.CopyFromRecordset method (specifying the leftmost worksheet cell to place results).
Also, see the changed connection open routine with proper connection string. And because recordsets do not pull in column headers automatically but only data, an added loop was included iterating through recordset's field names.
Private Sub tryagain()
Dim con As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim strConnection As String
Dim i as Integer, fld As Object
strConnection = "Provider=Microsoft.ACE.OLEDB.12.0;" _
& "Data Source='C:\Users\Ashleysaurus\Desktop\xyzmanu3.accdb';"
con.Open strConnection
rs.Open "SELECT * FROM [Invoice Query]", con
' column headers
i = 0
Sheets(1).Range("A1").Activate
For Each fld In rs.Fields
ActiveCell.Offset(0, i) = fld.Name
i = i + 1
Next fld
' data rows
Sheets(1).Range("A2").CopyFromRecordset rs
rs.Close
cn.Close
End Sub
By the way, this same above setup can even query Excel workbooks as the Jet/ACE SQL Engine is a Windows technology (.dll files) available to all Office or Windows programs.
strConnection = "Provider=Microsoft.ACE.OLEDB.12.0;" _
& "Data Source='C:\Path\To\Workbook.xlsm';" _
& "Extended Properties=""Excel 8.0;HDR=YES;"";"
strSQL = "SELECT * FROM [Sheet1$]"

Update Data in Excel File From Different Excel File Using SQL

I have two Excel files, a master file and a regular file. Both files have a sheet with the same data structure (same fields, but not formatted as tables).
What I'm trying to do is use VBA to create data connections to both files, and then use SQL to update the master file with any changes in the regular file. The reason for using SQL and a data connection is to avoid opening the regular file and hopefully faster performance overall.
I'm having difficulty with the UPDATE statement, and I'm not sure I'm even going about this in the best manner. My code thus far:
Sub Main()
Dim cnn1 As New ADODB.Connection
Dim cnn2 As New ADODB.Connection
Dim rst1 As New ADODB.Recordset
Dim rst2 As New ADODB.Recordset
Dim arrData() As Variant
Dim fPath As String
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False
.Filters.Add "Files", "*.xls*"
.InitialFileName = ThisWorkbook.Path & "/Meeting Cuts"
.Title = "Please select the file that contains the values you'd like to import."
.Show
fPath = .SelectedItems(1)
End With
DoEvents
cnn1.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & CStr(fPath) & ";" & "Extended Properties=""Excel 12.0;HDR=Yes;"";"
cnn2.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & "Data Source=" & CStr(ThisWorkbook.FullName) & ";" & "Extended Properties=""Excel 12.0;HDR=Yes;"";"
rst1.Open "SELECT * FROM [Sheet1$];", cnn1, adOpenStatic, adLockReadOnly
rst2.Open "UPDATE [Account Data$]" & _
"SET Account_ID = (SELECT Account_ID FROM " & rst1.GetRows & " WHERE Empl_Name = 'Smith,John')" & _
"WHERE Empl_Name = 'Smith,John'", cnn2, adOpenStatic, adLockReadOnly
Set rst1 = Nothing
Set rst2 = Nothing
Set cnn1 = Nothing
Set cnn2 = Nothing
End Sub
When I execute the code, I get a Run-time error '13': Type Mismatch on the rst2.Open line. When I go into debug mode and try to execute that line again, I get a different error: Run-time error '3021': Either BOF or EOF is True, or the current record has been deleted. Requested operation requires a current record.
I know that I'm using GetRows improperly. Is there a way to reference the sheet (from the regular file) somehow in the UPDATE statement? If so, how would I do it?

Using Excel VBA to export data to MS Access table

I am currently using following code to export data from worksheet to MS Access database, the code is looping through each row and insert data to MS Access Table.
Public Sub TransData()
Application.ScreenUpdating = False
Application.EnableAnimations = False
Application.EnableEvents = False
Application.DisplayAlerts = False
ActiveWorkbook.Worksheets("Folio_Data_original").Activate
Call MakeConnection("fdMasterTemp")
For i = 1 To rcount - 1
rs.AddNew
rs.Fields("fdName") = Cells(i + 1, 1).Value
rs.Fields("fdDate") = Cells(i + 1, 2).Value
rs.Update
Next i
Call CloseConnection
Application.ScreenUpdating = True
Application.EnableAnimations = True
Application.EnableEvents = True
Application.DisplayAlerts = True
End Sub
Public Function MakeConnection(TableName As String) As Boolean
'*********Routine to establish connection with database
Dim DBFullName As String
Dim cs As String
DBFullName = Application.ActiveWorkbook.Path & "\FDData.mdb"
cs = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & DBFullName & ";"
Set cn = CreateObject("ADODB.Connection")
If Not (cn.State = adStateOpen) Then
cn.Open cs
End If
Set rs = CreateObject("ADODB.Recordset")
If Not (rs.State = adStateOpen) Then
rs.Open TableName, cn, adOpenKeyset, adLockOptimistic
End If
End Function
Public Function CloseConnection() As Boolean
'*********Routine to close connection with database
On Error Resume Next
If Not rs Is Nothing Then
rs.Close
End If
If Not cn Is Nothing Then
cn.Close
End If
CloseConnection = True
Exit Function
End Function
Above code works fine for few hundred lines of records, but apparently it will be more data to export, Like 25000 records, is it possible to export without looping through all records and just one SQL INSERT statement to bulk insert all data to Ms.Access Table in one go?
Any help will be much appreciated.
EDIT: ISSUE RESOLVED
Just for information if anybody seeks for this, I've done a lots of search and found the following code to be work fine for me, and it is real fast due to SQL INSERT, (27648 records in just 3 seconds!!!!):
Public Sub DoTrans()
Set cn = CreateObject("ADODB.Connection")
dbPath = Application.ActiveWorkbook.Path & "\FDData.mdb"
dbWb = Application.ActiveWorkbook.FullName
dbWs = Application.ActiveSheet.Name
scn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbPath
dsh = "[" & Application.ActiveSheet.Name & "$]"
cn.Open scn
ssql = "INSERT INTO fdFolio ([fdName], [fdOne], [fdTwo]) "
ssql = ssql & "SELECT * FROM [Excel 8.0;HDR=YES;DATABASE=" & dbWb & "]." & dsh
cn.Execute ssql
End Sub
Still working to add specific fields name instead of using "Select *", tried various ways to add field names but can't make it work for now.
is it possible to export without looping through all records
For a range in Excel with a large number of rows you may see some performance improvement if you create an Access.Application object in Excel and then use it to import the Excel data into Access. The code below is in a VBA module in the same Excel document that contains the following test data
Option Explicit
Sub AccImport()
Dim acc As New Access.Application
acc.OpenCurrentDatabase "C:\Users\Public\Database1.accdb"
acc.DoCmd.TransferSpreadsheet _
TransferType:=acImport, _
SpreadSheetType:=acSpreadsheetTypeExcel12Xml, _
TableName:="tblExcelImport", _
Filename:=Application.ActiveWorkbook.FullName, _
HasFieldNames:=True, _
Range:="Folio_Data_original$A1:B10"
acc.CloseCurrentDatabase
acc.Quit
Set acc = Nothing
End Sub
#Ahmed
Below is code that specifies fields from a named range for insertion into MS Access. The nice thing about this code is that you can name your fields in Excel whatever the hell you want (If you use * then the fields have to match exactly between Excel and Access) as you can see I have named an Excel column "Haha" even though the Access column is called "dte".
Sub test()
dbWb = Application.ActiveWorkbook.FullName
dsh = "[" & Application.ActiveSheet.Name & "$]" & "Data2" 'Data2 is a named range
sdbpath = "C:\Users\myname\Desktop\Database2.mdb"
sCommand = "INSERT INTO [main] ([dte], [test1], [values], [values2]) SELECT [haha],[test1],[values],[values2] FROM [Excel 8.0;HDR=YES;DATABASE=" & dbWb & "]." & dsh
Dim dbCon As New ADODB.Connection
Dim dbCommand As New ADODB.Command
dbCon.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & sdbpath & "; Jet OLEDB:Database Password=;"
dbCommand.ActiveConnection = dbCon
dbCommand.CommandText = sCommand
dbCommand.Execute
dbCon.Close
End Sub