INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Jobs

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: 9 May 03

' 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



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


Back to Microsoft: Access Modules (VBA Coding) FAQ Index
Back to Microsoft: Access Modules (VBA Coding) Forum

My Archive

Resources

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close