Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations Mike Lewis on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Could you show me some sample code to get me started on importing a CSV file into Access?

Import CSV data using VBA

Could you show me some sample code to get me started on importing a CSV file into Access?

by  beetee  Posted    (Edited  )
' following is a simplistic approach to importing CSV data into Access.
' note the lack of any real error handling; this should be dealt with.
' However, it should get you started
' At the end is a sample 'call' to the function
' note that this code will support storing the field names
' in the first line of the record

[tt]

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:\SomeData.csv", MyRst, ErrorMsg, False
MyRst.Close
Set MyRst = Nothing
End Sub

[/tt]
Register to rate this FAQ  : BAD 1 2 3 4 5 6 7 8 9 10 GOOD
Please Note: 1 is Bad, 10 is Good :-)

Part and Inventory Search

Back
Top