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,
Related
Hi May Would Like to know why Copyfromrecordset wont work
Any work around using ADO?
I only have one Table One Number COlumn and it does not accept duplicates.
Also need to retrieve the ID number in order to be used by other codes for MultiUser Purpose.
Sub PostData()
Dim cnn As ADODB.Connection 'dim the ADO collection class
Dim rst As ADODB.Recordset 'dim the ADO recordset classe here
Dim dbPath
Dim x As Long, i As Long
'add error handling
On Error GoTo errHandler:
dbPath = Sheets("Sheet3").Range("h1").Value
Set cnn = New ADODB.Connection
cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dbPath
Set rst = New ADODB.Recordset 'assign memory to the recordset
Sql = "INSERT INTO DvID(DVnumber)SELECT Max(DVNumber)+1 FROM DvID "
rst.Open Sql, cnn
Sheet3.Range("A2").CopyFromRecordset rst
rst.Close
cnn.Close
Set rst = Nothing
Set cnn = Nothing
On Error GoTo 0
Exit Sub
errHandler:
Set rst = Nothing
Set cnn = Nothing
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure Export_Data"
End Sub
See this paragraph in Remarks
It is not a good idea to use the Source argument of the Open method to perform an action query that does not return records because there is no easy way to determine whether the call succeeded. The Recordset returned by such a query will be closed. To perform a query that does not return records, such as a SQL INSERT statement, call the Execute method of a Command object or the Execute method of a Connection object instead.
If you work around with separate select and insert queries, the risk is that another user could create a record in between the two. Using an Auto-Increment key is preferred. With that caveat try
Sub PostData()
Dim cnn As ADODB.Connection 'dim the ADO collection class
Dim rst As ADODB.Recordset 'dim the ADO recordset classe here
Dim dbPath As String, sql As String
Dim newID As Long
'add error handling
On Error GoTo errHandler:
dbPath = Sheets("Sheet3").Range("h1").Value
Set cnn = New ADODB.Connection
cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dbPath
Set rst = New ADODB.Recordset 'assign memory to the recordset
rst.Open "SELECT MAX(DVNumber)+1 FROM DvID", cnn
newID = rst(0)
cnn.Execute "INSERT INTO DvID(DVnumber) VALUES (" & newID & ")"
Sheet3.Range("A2") = newID
rst.Close
cnn.Close
Set rst = Nothing
Set cnn = Nothing
MsgBox newID & " Inserted", vbInformation
On Error GoTo 0
Exit Sub
errHandler:
Set rst = Nothing
Set cnn = Nothing
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure PostData"
End Sub
I have a working VBA code that exports data from MS Access data and pastes it into MS Excel Sheet cells and using cell range as RowSource to appear data in the ListBox.
Is there a way to paste directly the imported data into ListBox instead of pasting into Sheet cells?
Sub IBDocsLibSearch()
Dim cnn As ADODB.Connection 'dim the ADO collection class
Dim rs As ADODB.Recordset 'dim the ADO recorset class
Dim dbPath As String
Dim MyDbPassword As String
Dim SQL As String
Dim i As Integer
Dim var1
Application.ScreenUpdating = False
IBDocLibSheet.Range("A2:I500000").ClearContents
dbPath = LinkSheet.Range("C4").Value 'Inbound Checklist Database Location
MyDbPassword = PWSheet.Range("C3").Value 'Password to connect the Excel to Access
Set var1 = IBUserForm.IBDTextSerialNo
'Initialise the collection class variable
Set cnn = New ADODB.Connection
cnn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dbPath & ";Jet OLEDB:Database Password=" & MyDbPassword
SQL = "SELECT * FROM DB_IBDocuments WHERE SerialNo = '" & var1.Value & "'"
Set rs = New ADODB.Recordset
rs.Open SQL, cnn
If rs.EOF And rs.BOF Then
'Close the recordset and connection
rs.Close
cnn.Close
'Clear Memory
Set rs = Nothing
Set cnn = Nothing
Application.ScreenUpdating = True
Exit Sub
End If
IBDocLibSheet.Range("A2").CopyFromRecordset rs '----This is where to paste the extracted data
'To show results in Listbox
IBUserForm.IBDListBox.RowSource = "IBL_DocLib"
'Close the recorset and connections
rs.Close
cnn.Close
'Clear memory
Set rs = Nothing
Set cnn = Nothing
Application.ScreenUpdating = True
End Sub
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
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$]"
I have a data table in excel with both numbers and text in the store number column. I need to use sql through an ADODB object in VBA to get a list of the store numbers in the column. I'm using the following to set up the ADODB.
The problem: If the query hits a number first then the field is treated as numbers and texts are ignored. and if a text is hit first the numbers are ignored.
I'm using the following to set up the ADODB. These are in the worksheet module hints me..
Public Function Query(qry As String) As ADODB.Recordset
Dim cn As ADODB.Connection '* Connection String
Dim rs As ADODB.Recordset '* Record Set
Dim sQuery As String '* Query String
Dim FileName As String
On Error GoTo QryErr
Set cn = New ADODB.Connection
FileName = ThisWorkbook.Path & "\" & ThisWorkbook.Name
cn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & FileName & _
";Extended Properties=Excel 8.0;Persist Security Info=False"
cn.ConnectionTimeout = 40
cn.Open
Set rs = New ADODB.Recordset
Select Case LCase(qry)
Case "dry": sQuery = SQLDry
Case "frz": sQuery = SQLFrz
Case "fsh": sQuery = SQLFsh
Case "temp": sQuery = SQLTemp
Case Else: GoTo QryErr
End Select
rs.ActiveConnection = cn
rs.Source = sQuery
rs.Open
Set Query = rs
If Not rs Is Nothing Then Set rs = Nothing
If Not cn Is Nothing Then Set cn = Nothing
QryErr:
If Err <> 0 Then
Debug.Assert Err = 0
MsgBox Err.Description
End If
End Function
And I have the following for the SQL portion.
Private Function SQLTemp() As String
Dim Name As String
Name = Me.Name
SQLTemp = "SELECT str([" & Name & "$].Store) as Store " & _
"FROM [" & Name & "$] " & _
"GROUP BY [" & Name & "$].Store"
End Function
As you can see I've tryed converting the field to str() but it doesn't help.
How can I get the query to treat the column as text so that all values are returned. I'd like to avoid putting ' in front of all my numbers.
Asked 5 years ago! I had the same problem. The solution for me was to change the data type of the offending columns (those with "special characters" and "TEXT" datatype) to "VARCHAR", or you can remove in the query the special characters, or change the CharacterSet by means of Schema.ini, as #Tim Williams suggests (msdn.microsoft.com/en-us/library/ms709353(v=vs.85).aspx).