ADO Connections

[Atravis]

Hi everyone,

I am trying to import data from a closed CSV via an ADO connection, however all text in alphanumeric columns is not pulled through. I have attached the workbook that i am using to import with, any help would really be appreciated.

Thanks.

[Atravis]

This is the data csv i have used in the test example.

[slamet Harto]

How about:
[VBA]Sub Copy_CSV()

Dim WB As Workbook
Dim MyWB, newbook As Workbook
Dim Sheet, Worksheet, myWorksheet As Worksheet
Dim Worksheets As Worksheets

Application.ScreenUpdating = False

With Application.FileSearch
.NewSearch
.LookIn = "C:\Documents and Settings\Administrator\My Documents\"
.SearchSubFolders = False
.FileType = msoFileTypeAllFiles
.Filename = "Test.Csv" '*.csv"


If .Execute() > 0 Then
Set WB = ActiveWorkbook
For i = 1 To .FoundFiles.Count
Set MyWB = Workbooks.Open(.FoundFiles(i))
MyWB.Worksheets(1).Copy Before:=WB.Sheets(1)

MyWB.Close savechanges:=True
Next i
End If
End With

Application.ScreenUpdating = True
End Sub[/VBA]

[Atravis]

Thanks for the suggestion, however i was hoping to use an ADO connection as in practice there are a fair quantity of workbooks, and the ADO connection tends to be much faster as it does not required the workbooks to be opened. I have a similar code for XLS which works fine and I am not sure why the CSV version is not pulling all the data.

[Bob Phillips]

You will struggle, as it will determine the data type by scanning a few rows. It obviously thinks these are numbers, and ignoring the non-numeric items.

[Kenneth Hobs]

As xld said, Excel will scan some rows to determine what field type the majority of those rows or records scanned are. For MaxScanRows in the Text type in the Jet engine, mine was set to 25 (19 hex). When I changed it to 1, it set as you wanted. If you set the parameter to 0, it will scan all of the rows but the majority would still be numeric for your first field.

The better method is to set up a schema.ini file to define your field types. Look through the forum for examples if you want to pursue that method as I don't use it much.

At the end, I posted my modification of your code. Instead of using the CopyFromRecordSet method, I iterated through the records and fields. Some of it is redundant but I wanted to show you some tricks.

Of course your CSV file is not consistently structured so there are some issues there regarding fields.

If you want to try the registy method, see the following exported Registry keys. The main point is to show you the path to the MaxScanRows key. If you use the Registry method, there are several ways to automate that should you want to restore what it was before and set it for your macro.

My default:

Windows Registry Editor Version 5.00
[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Jet\4.0\Engines\Text]
"win32"="C:\\WINDOWS\\system32\\mstext40.dll"
"UseZeroMaxScanAs"="One"
"ImportMixedTypes"="Majority Type"
"DisabledExtensions"="!txt,csv,tab,asc,tmp,htm,html"
"CharacterSet"="ANSI"
"ImportFixedFormat"="RaggedEdge"
"Format"="CSVDelimited"
"Extensions"="txt,csv,tab,asc"
"FirstRowHasNames"=hex:01
"MaxScanRows"=dword:00000019
"ExportCurrencySymbols"=hex:01

Changed the key to 1:

Windows Registry Editor Version 5.00
[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Jet\4.0\Engines\Text]
"win32"="C:\\WINDOWS\\system32\\mstext40.dll"
"UseZeroMaxScanAs"="One"
"ImportMixedTypes"="Majority Type"
"DisabledExtensions"="!txt,csv,tab,asc,tmp,htm,html"
"CharacterSet"="ANSI"
"ImportFixedFormat"="RaggedEdge"
"Format"="CSVDelimited"
"Extensions"="txt,csv,tab,asc"
"FirstRowHasNames"=hex:01
"MaxScanRows"=dword:00000001
"ExportCurrencySymbols"=hex:01

[vba]Sub pull_data()

Dim s1 As Worksheet, ML_Dir As String
'ML_Dir = "H:\Documents"
ML_Dir = ThisWorkbook.Path
'Call Open_Sort_CSV(ML_Dir, "test.csv", "Sheet1")
Call Open_Sort_CSV(ML_Dir, "ImportCSV.csv", "Sheet1", "Yes")
End Sub
Sub Open_Sort_CSV(CSV_Dir, CSV_name, Data_Sheet, Optional Header As String = "No")
Dim connectionString As String, objConnection As Object, objRecordset As Object
Dim A As Integer
Dim Location As Range, Rw As Long, col As Integer, c As Integer, MyField As Variant
'set record set variables
Const adOpenStatic = 3
Const adLockOptimistic = 3
Const adCmdText = &H1

'ser connection and recordset
Set objConnection = CreateObject("ADODB.Connection")
Set objRecordset = CreateObject("ADODB.Recordset")

'oopen connection (headers,Delimited style,mixed data taken as text(not sure imex works))
'connectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & CSV_Dir & ";" & _
"Extended Properties=""text;HDR=" & Header & ";FMT=Delimited;IMEX=1"""
connectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & CSV_Dir & ";" & _
"Extended Properties=""text;HDR=" & Header & ";FMT=Delimited(,);"""
objConnection.Open connectionString

'get data from csv
objRecordset.Open "SELECT * FROM " & CSV_name, _
objConnection, adOpenStatic, adLockOptimistic, adCmdText

'Loop across the fields
If Header = "Yes" Then
With objRecordset
For A = 0 To .Fields.Count - 1

' Add field names to data sheet
ThisWorkbook.Worksheets(Data_Sheet).Cells(1, 1).Offset(0, A).Value = .Fields(A).Name
Next A
End With

'this errors for no good reason so stop any errors
'On Error Resume Next

'copy data into worksheet under headers
'ThisWorkbook.Worksheets(Data_Sheet).Cells(2, 1).CopyFromRecordset objRecordset
'Write RecordSet to results area
Set Location = Range("A2")
Rw = Location.Row
col = Location.Column
c = col
With objRecordset
Do Until .EOF
For Each MyField In .Fields
If MyField.Name = "Data Used" Then
Cells(Rw, c) = CStr(MyField)
Else: Cells(Rw, c) = MyField
End If
c = c + 1
Next MyField
.MoveNext
Rw = Rw + 1
c = col
Loop
End With

Else
'copy data into worksheet
ThisWorkbook.Worksheets(Data_Sheet).Cells(1, 1).CopyFromRecordset objRecordset
End If
'end connection and recordset
Set objConnection = Nothing
Set objRecordset = Nothing

End Sub
[/vba]

[Atravis]

Hi All,
Thanks for the advice. I attempted to use a schema to pull the data in which worked well for the test file I provided. However for some of the larger files I had it simply wouldn't pull in data past Column("J"), which is odd because without the schema it would but with the alphnumeric issues that were apparant before.

In the end i used the following code to read in the CSV and then use text-to-columns;

[vba]Sub Pull_CSV(Filename As String, Data_Sheet As String)

Dim fs As New FileSystemObject
Dim stream As TextStream
Dim line As String
Dim rowIndex As Integer
Set stream = fs.OpenTextFile(Filename)

rowIndex = 1

While Not stream.AtEndOfStream
line = stream.ReadLine
On Error Resume Next
Worksheets(Data_Sheet).Cells(rowIndex, "A").Value = Split(line, ";")
On Error GoTo 0
rowIndex = rowIndex + 1
Wend

Worksheets(Data_Sheet).Columns("A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
:=Array(1, 1), TrailingMinusNumbers:=True
End Sub[/vba]

It still seems like a better way of pulling data than opening the workbooks, although i'm not sure how efficient it is.