Import CSV data to Ms Access Using VBA

[Miranhat]

Hi there, I am trying to import CSV to MS Access using vba. when i run
the module encount an error msgs..type mismatch in this line

Sub TestCsvImport() 'I have created the table and have the path
directed. still not running properly. Please your help is greatly
appreciated. Thank You

.....here is the code


Option Compare Database
Option Explicit

' read a csv file into a recordset
' can handle a first line with field names (e.g. a header)
' deals with quoted strings in csv data (e.g. "this is a test,,,,",
this,is,a,test
'
Function ImportCsvFile(FileName As String, DestRst As Recordset,
ErrorMsg As String, Optional HasHeaders As Boolean = False) As Long
On Error GoTo ImportCsvFileError
' open the source file
Dim InputFileHandle As Integer
InputFileHandle = FreeFile
Open FileName For Input As #InputFileHandle

' set the current character read from the file
Dim CurChar As String
CurChar = ""

' set the previous character read from the file
Dim PrevChar As String
PrevChar = ""

' indicate if the next character has already been 'read'
Dim ReadAhead As Boolean
ReadAhead = False

' store field names in a header
Dim ReadFieldNames(0 To 511) As String

' indicate if we are currently reading a header line
Dim ReadingHeaderLine As Boolean
ReadingHeaderLine = HasHeaders

' the current field (text between commas)
Dim CurField As String
CurField = ""

' indicate if we are inside a quoted field
Dim InQuote As Boolean
InQuote = False

' the current field number (index into the field names array
*or* the recordset)
Dim FieldNumber As Integer
FieldNumber = 0

' indicate if a field has been read (e.g. a comma or EOL has
been reached)
Dim SetField As Boolean
SetField = False

' indicate if a record should be added (e.g. EOL has been
reached)
Dim AddRecord As Boolean
AddRecord = False

' indicate if a DestRst.Update method needs to be invoked
Dim NeedsUpdate As Boolean
NeedsUpdate = False

' indicate if a DestRst.AddNew method needs to be invoked
Dim NeedToAdd As Boolean
NeedToAdd = True

Do While Not EOF(InputFileHandle) ' Loop until end of file.
' sometimes we need to read ahead one character (e.g. for a
"), then find we want to put
' that character back into the input stream.
If Not ReadAhead Then
CurChar = Input(1, #InputFileHandle) ' Get one character.
End If
ReadAhead = False

Select Case CurChar
' handle quoted strings in the CSV data, allowing embedded
commas or quotes.
Case """"
If InQuote Then
If Not EOF(InputFileHandle) Then
CurChar = Input(1, #InputFileHandle)
If CurChar = """" Then
CurField = CurField & """"
Else
ReadAhead = True
InQuote = False
End If
Else
InQuote = False
End If
Else
InQuote = True
End If
' handle the comma character (End of Field, unless in a
quoted string)
Case ","
If InQuote Then
CurField = CurField & ","
Else
SetField = True
End If
' handle all other characters
' toss out any CR's, and treat LF's as end of line.
Case Else
If Asc(CurChar) <> 13 Then
If Asc(CurChar) = 10 Then
SetField = True
AddRecord = True
Else
CurField = CurField & CurChar
End If
End If
End Select
' either set a field name (if header), or set a field value
(based on field name in header, or field number)
If SetField Then
If NeedToAdd Then
DestRst.AddNew ' add a new record
NeedToAdd = False ' clear need to add
NeedsUpdate = True ' we do need to do an update
before doing another Add
End If
CurField = Trim(CurField)

If ReadingHeaderLine Then ' store field name
ReadFieldNames(FieldNumber) = CurField
Else
' only add fields that are non-zero-length
If Len(CurField) > 0 Then
If HasHeaders Then ' set field value (either
from name, or field number)
DestRst(ReadFieldNames(FieldNumber)) = CurField
Else
DestRst(FieldNumber) = CurField
End If
End If
End If
FieldNumber = FieldNumber + 1 ' bump field number
CurField = "" ' clear field for more data
SetField = False ' wait for a comma or EOL
End If

' if we hit EOL, Update any existing changes, and indicate
we need to add
' another record if we encounter more data
If AddRecord Then
If NeedsUpdate Then
DestRst.Update
NeedsUpdate = False
End If
NeedToAdd = True ' if we hit more data, do
an .AddNew
FieldNumber = 0 ' start at field 0
ReadingHeaderLine = False ' there can only be one
header line
AddRecord = False
DoEvents
End If

PrevChar = CurChar
Loop
If NeedsUpdate Then
DestRst.Update
End If
Close #InputFileHandle

ImportCsvFileExit:
Exit Function

ImportCsvFileError:
Resume
End Function

Sub TestCsvImport()
Dim ErrorMsg As String

Dim MyRst As Recordset
Set MyRst = CurrentDb.OpenRecordset("sometable")


ImportCsvFile "C:\data\Access\SumoguiPipeline.csv", MyRst,
ErrorMsg, False
MyRst.Close
Set MyRst = Nothing
End Sub

 

[John Nurick]

This line
Sub TestCsvImport()
cannot produce a type mismatch error because all it does is declare a
procedure. Please indicate where the error is actually occurring.

If this is more than a learning exercise for you, I'd be interested to
know which problems with DoCmd.TransferText acImportDelim you are
working round.

Hi there, I am trying to import CSV to MS Access using vba. when i run
the module encount an error msgs..type mismatch in this line

Sub TestCsvImport() 'I have created the table and have the path
directed. still not running properly. Please your help is greatly
appreciated. Thank You

....here is the code

[snip]

 

[Roger Carlson]

First of all, do you have a reference to DAO set? You do this in a code
module, go to Tools > References and scroll down the list until you find and
select Microsoft DAO 3.6 Object Library.

Next, you should explictly reference the object library. DAO.Recordset

Next, you should create a database object, rather than creating the
recordset directly from the CurrentDb:

Dim db as DAO.Database
Dim rs as DAO.Recordset
Set db = CurrentDb
Set rs = db.OpenRecordset("sometable")

--
--Roger Carlson
MS Access MVP
Access Database Samples: www.rogersaccesslibrary.com
Want answers to your Access questions in your Email?
Free subscription:
http://peach.ease.lsoft.com/scripts/wa.exe?SUBED1=ACCESS-L

 

[Miranhat]

Hi John,

Am sorry, the is between

Sub TestCsvImport()
Dim ErrorMsg As String


Dim MyRst As Recordset


" Here I GET THE ERROR MASSAGE bellowline Type mismatch (Error 13)"

Set MyRst = CurrentDb.OpenRecordset("sometable")


ImportCsvFile "C:\data\Access\SumoguiPipeline.csv", MyRst,
ErrorMsg, False
MyRst.Close
Set MyRst = Nothing
End Sub

 

[Miranhat]

Hi Roger,

Thank You.

I had my Reference to DAO 3.6 Object Library set. Now I have added your
code that you have provided. However now my error msgs is..Type
Mismatch again to this bellow code. Thank You once again. Please help
me out.

ImportCsvFile "C:\data\Access\SumoguiPipeline.csv", rs, ErrorMsg, False

 

[John Nurick]

You also need to disambiguate the recordset in the declaration of
ImportCsvFile();

Function ImportCsvFile(..., DestRst As DAO.Recordset, ...

 

[Miranhat]

Hey John,

Thanks for your reply. I have added everything...now it's keep getting
freeze on me. I don't know what's going. Everytime i try to run the
module i can't do it. It keep freezing please help me out....this is
what i have now...


Option Compare Database
Option Explicit

' read a csv file into a recordset
' can handle a first line with field names (e.g. a header)
' deals with quoted strings in csv data (e.g. "this is a test,,,,",
this,is,a,test
'
Function ImportCsvFile(FileName As String, DestRst As DAO.Recordset,
ErrorMsg As String, Optional HasHeaders As Boolean = False) As Long
On Error GoTo ImportCsvFileError
' open the source file
Dim InputFileHandle As Integer
InputFileHandle = FreeFile
Open FileName For Input As #InputFileHandle

' set the current character read from the file
Dim CurChar As String
CurChar = ""

' set the previous character read from the file
Dim PrevChar As String
PrevChar = ""

' indicate if the next character has already been 'read'
Dim ReadAhead As Boolean
ReadAhead = False

' store field names in a header
Dim ReadFieldNames(0 To 511) As String

' indicate if we are currently reading a header line
Dim ReadingHeaderLine As Boolean
ReadingHeaderLine = HasHeaders

' the current field (text between commas)
Dim CurField As String
CurField = ""

' indicate if we are inside a quoted field
Dim InQuote As Boolean
InQuote = False

' the current field number (index into the field names array
*or* the recordset)
Dim FieldNumber As Integer
FieldNumber = 0

' indicate if a field has been read (e.g. a comma or EOL has
been reached)
Dim SetField As Boolean
SetField = False

' indicate if a record should be added (e.g. EOL has been
reached)
Dim AddRecord As Boolean
AddRecord = False

' indicate if a DestRst.Update method needs to be invoked
Dim NeedsUpdate As Boolean
NeedsUpdate = False

' indicate if a DestRst.AddNew method needs to be invoked
Dim NeedToAdd As Boolean
NeedToAdd = True

Do While Not EOF(InputFileHandle) ' Loop until end of file.
' sometimes we need to read ahead one character (e.g. for a
"), then find we want to put
' that character back into the input stream.
If Not ReadAhead Then
CurChar = Input(1, #InputFileHandle) ' Get one character.
End If
ReadAhead = False

Select Case CurChar
' handle quoted strings in the CSV data, allowing embedded
commas or quotes.
Case """"
If InQuote Then
If Not EOF(InputFileHandle) Then
CurChar = Input(1, #InputFileHandle)
If CurChar = """" Then
CurField = CurField & """"
Else
ReadAhead = True
InQuote = False
End If
Else
InQuote = False
End If
Else
InQuote = True
End If
' handle the comma character (End of Field, unless in a
quoted string)
Case ","
If InQuote Then
CurField = CurField & ","
Else
SetField = True
End If
' handle all other characters
' toss out any CR's, and treat LF's as end of line.
Case Else
If Asc(CurChar) <> 13 Then
If Asc(CurChar) = 10 Then
SetField = True
AddRecord = True
Else
CurField = CurField & CurChar
End If
End If
End Select
' either set a field name (if header), or set a field value
(based on field name in header, or field number)
If SetField Then
If NeedToAdd Then
DestRst.AddNew ' add a new record
NeedToAdd = False ' clear need to add
NeedsUpdate = True ' we do need to do an update
before doing another Add
End If
CurField = Trim(CurField)

If ReadingHeaderLine Then ' store field name
ReadFieldNames(FieldNumber) = CurField
Else
' only add fields that are non-zero-length
If Len(CurField) > 0 Then
If HasHeaders Then ' set field value (either
from name, or field number)
DestRst(ReadFieldNames(FieldNumber)) = CurField
Else
DestRst(FieldNumber) = CurField
End If
End If
End If
FieldNumber = FieldNumber + 1 ' bump field number
CurField = "" ' clear field for more data
SetField = False ' wait for a comma or EOL
End If

' if we hit EOL, Update any existing changes, and indicate
we need to add
' another record if we encounter more data
If AddRecord Then
If NeedsUpdate Then
DestRst.Update
NeedsUpdate = False
End If
NeedToAdd = True ' if we hit more data, do
an .AddNew
FieldNumber = 0 ' start at field 0
ReadingHeaderLine = False ' there can only be one
header line
AddRecord = False
DoEvents
End If

PrevChar = CurChar
Loop
If NeedsUpdate Then
DestRst.Update
End If
Close #InputFileHandle

ImportCsvFileExit:
Exit Function

ImportCsvFileError:
Resume
End Function
Sub TestCsvImport()

Dim ErrorMsg As String
Dim MyRst As DAO.Recordset
Dim db As DAO.Database
Set db = CurrentDb
Set MyRst = db.OpenRecordset("sometable")

ImportCsvFile "C:\data\Access\SumoguiPipeline.csv", MyRst,
ErrorMsg, False
MyRst.Close
Set MyRst = Nothing
End Sub

 

[John Nurick]

I suspect that the "freeze" is actually an infinite loop. If an error
occurs in ImportCSVFile(), control passes from the statement that raised
the error to the error handler at ImportCSVFileError:. The first
statement in the error handler is
Resume
which returns control to the statement where the error occurs -
whereupon a new error is raised, which causes control to pass to the
error handler, and so on. It's far better to use no error handler than
to have something as useless as this.

For now, remove the
On Error Goto ImportCsvFileError
line and the counterproductive error handler. You will then be able to
see where your code is actually going wrong.

I think I can see some problematic aspects. One is that you declare a
512-element array for field names, although Access will allow at most
255 fields in a recordset. Another is that (on a brief reading) you
neither check that DestRst contains at enough fields for the text file,
nor handle the situation where a line in the text file contains more
fields than DestRst. Good programming practice, IMHO, requires both. A
third is that you don't check that the values you are assigning to
fields in DestRst match the data types of those fields. (You may of
course be making these checks in code you haven't shown us.)