prashant007
New Member
- Joined
- Aug 11, 2011
- Messages
- 2
Hi,
I have come acrros one problem if you can help me plaese...
I have write a code to import a csv file in to Excel.
When I run this code to Import a csv file I'm not getting right field name(Table heading). Error in importing field name , I'm getting field name like <VAR id=yiv484341109yui-ie-cursor></VAR>, F1, F2, F3.....
Here is my code:
Public Sub QueryCSVFile()
Dim lOffset As Long
Dim rsData As ADODB.Recordset
Dim objField As ADODB.Field
Dim sConnect As String
Dim sSQL As String
Dim strFilePath As String, strFilename As String, strFullPath As String
Dim lngCounter As Long
Dim oConn As Object, oRS As Object, oFSObj As Object
Dim Question As Variant
Application.ScreenUpdating = False
strFullPath = Application.GetOpenFilename("Text Files (*.csv),*.csv", , "Please selec text file...")
If strFullPath = "False" Then Exit Sub 'User pressed Cancel on the open file dialog
'This gives us a full path name e.g. C:tempfolderfile.txt
'We need to split this into path and file name
Set oFSObj = CreateObject("SCRIPTING.FILESYSTEMOBJECT")
strFilePath = oFSObj.GetFile(strFullPath).ParentFolder.Path
strFilename = oFSObj.GetFile(strFullPath).Name
' Create the connection string.
sConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & strFilePath & ";" & _
"Extended Properties=""text;HDR=Yes;FMT=Delimited"""
' Create the SQL statement.
sSQL = "SELECT * FROM " & strFilename & ";"
Set rsData = New ADODB.Recordset
rsData.Open sSQL, sConnect, adOpenForwardOnly, _
adLockReadOnly, adCmdText
Worksheets("Sheet1").Activate
Range("a1").Activate
If Not rsData.EOF Then
' Add headers to the worksheet.
With Range("A1")
For Each objField In rsData.Fields
.Offset(0, lOffset).Value = objField.Name
lOffset = lOffset + 1
Next objField
.Resize(1, rsData.Fields.Count).Font.Bold = True
End With
' Copy the data from recordset
Range("a2").Activate
Range("A2").CopyFromRecordset rsData
Else
MsgBox "No records returned.", vbCritical
End If
' Clean up our Recordset object.
rsData.Close
Set rsData = Nothing
Application.ScreenUpdating = True
End Sub
I have come acrros one problem if you can help me plaese...
I have write a code to import a csv file in to Excel.
When I run this code to Import a csv file I'm not getting right field name(Table heading). Error in importing field name , I'm getting field name like <VAR id=yiv484341109yui-ie-cursor></VAR>, F1, F2, F3.....
Here is my code:
Public Sub QueryCSVFile()
Dim lOffset As Long
Dim rsData As ADODB.Recordset
Dim objField As ADODB.Field
Dim sConnect As String
Dim sSQL As String
Dim strFilePath As String, strFilename As String, strFullPath As String
Dim lngCounter As Long
Dim oConn As Object, oRS As Object, oFSObj As Object
Dim Question As Variant
Application.ScreenUpdating = False
strFullPath = Application.GetOpenFilename("Text Files (*.csv),*.csv", , "Please selec text file...")
If strFullPath = "False" Then Exit Sub 'User pressed Cancel on the open file dialog
'This gives us a full path name e.g. C:tempfolderfile.txt
'We need to split this into path and file name
Set oFSObj = CreateObject("SCRIPTING.FILESYSTEMOBJECT")
strFilePath = oFSObj.GetFile(strFullPath).ParentFolder.Path
strFilename = oFSObj.GetFile(strFullPath).Name
' Create the connection string.
sConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source=" & strFilePath & ";" & _
"Extended Properties=""text;HDR=Yes;FMT=Delimited"""
' Create the SQL statement.
sSQL = "SELECT * FROM " & strFilename & ";"
Set rsData = New ADODB.Recordset
rsData.Open sSQL, sConnect, adOpenForwardOnly, _
adLockReadOnly, adCmdText
Worksheets("Sheet1").Activate
Range("a1").Activate
If Not rsData.EOF Then
' Add headers to the worksheet.
With Range("A1")
For Each objField In rsData.Fields
.Offset(0, lOffset).Value = objField.Name
lOffset = lOffset + 1
Next objField
.Resize(1, rsData.Fields.Count).Font.Bold = True
End With
' Copy the data from recordset
Range("a2").Activate
Range("A2").CopyFromRecordset rsData
Else
MsgBox "No records returned.", vbCritical
End If
' Clean up our Recordset object.
rsData.Close
Set rsData = Nothing
Application.ScreenUpdating = True
End Sub