Source code for Issue Number 65

Copyright 1997-2000 by C&D Programming Corp. All Rights Reserved. Source code may not be reproduced except for use in a compiled executable. All rights reserved. If you would like to reprint any or all of this code please email us at info@codeoftheweek.com

Code of the Week Home


Source Code

Just paste this code into a class module and change the name of the class to cImportCSV.

'----------------------------------------------------------------------
'
'   Module Name:    cImportCSV
'   Written By:     C&D Programming Corp.
'   Create Date:    10/98
'   Copyright:      Copyright 1998 by C&D Programming Corp.  Source
'                   code may not be reproduced except for use in a
'                   compiled executable.  All rights reserved.  If
'                   you would like to reprint any or all of this
'                   code please email us at info@codeoftheweek.com
'----------------------------------------------------------------------
Option Explicit

' CSV = Comma Separated Values (better known as comma-delimited)
'
'
' A suggestion for this to work better is for the csv file to have the
' field names as the first line.  If it doesn't then the field names
' in the imported table will be called F1, F2, F3, F4, etc...
'
' A sample CSV file looks like this:
'
' "name","email","date added"
' "John Smith","john@codeoftheweek.com","12/1/98 11:30:11 am"
'

Private msCSVFilename As String     ' name of the file to import
Private msCSVFilePath As String     ' Path to the file to import

Public DatabaseName As String       ' database name to import the data into
Public NewTableName As String       ' name of the table to create in the database name

'
'   This is the directory of the location of the file to be imported.
'
Public Property Let CSVFilePath(sCSVFilepath As String)
    If Right(sCSVFilepath, 1) <> "\" Then
        msCSVFilePath = sCSVFilepath & "\"
    Else
        msCSVFilePath = sCSVFilepath
    End If
End Property

Public Property Get CSVFilePath() As String
    CSVFilePath = msCSVFilePath
End Property

'
'   This is just the filename of the file to be imported.
'
Public Property Let CSVFilename(sCSVFilename As String)
    Dim lExtLocation As Long

    If CSVFilePath = "" Then
        Err.Raise 5, "CSVFilename", "Please set the CSVFilePath property before calling CSVFilename"
    End If

    msCSVFilename = sCSVFilename
    If Dir(CSVFilePath & msCSVFilename) = "" Then
        Err.Raise 53, "CSVFilename", "Could not locate the filename " & CSVFilePath & msCSVFilename
    End If

    ' the SQL interpreter seems to require a # sign where the extension
    ' separator normally appears.  So, if your import filename is
    ' called import.txt then this little routine will convert it to
    ' import#txt
    lExtLocation = InStr(msCSVFilename, ".")
    If lExtLocation <> 0 Then
        Mid(msCSVFilename, lExtLocation, 1) = "#"
    End If
End Property

Public Property Get CSVFilename() As String
    CSVFilename = msCSVFilename
End Property

Public Function ImportData() As Long
    Dim dbCSV As Database
    Dim sImportQuery As String

    On Error GoTo Handler

    ImportData = 0  ' assume this function fails, so return 0 as the number
                    ' of records imported

    ' open the text file as a database
    '
    Set dbCSV = OpenDatabase(CSVFilePath, True, False, "text;")

    ' this is the SQL necessary to import a file from one table into another database.
    ' The general format is:
    '
    ' SELECT imptable.* INTO newtable IN 'e:\temp\data.mdb' FROM imptable
    '
    sImportQuery = "SELECT " & CSVFilename & ".* INTO " & NewTableName & " IN '" & DatabaseName & "' FROM " & CSVFilename

    On Error Resume Next
    ' import the data, check for errors in case the table already
    ' exists in the destination database.
    dbCSV.Execute sImportQuery
    If Err = 3010 Then  ' table already exists then remove it.
        Err.Clear       ' clear the error
        RemoveTable DatabaseName, NewTableName
        If Err Then
            dbCSV.Close
            Set dbCSV = Nothing
            Err.Raise Err.Number, Err.Source, Err.Description
        End If
        On Error GoTo Handler
        dbCSV.Execute sImportQuery  ' try import again after we removed the table
    End If

    ' return the number of records imported
    ImportData = dbCSV.RecordsAffected
    dbCSV.Close
    Set dbCSV = Nothing
    Exit Function

Handler:
    Err.Raise Err.Number, "ImportData", Err.Description
End Function
'
'   This routine shows how to remove a table from a database
'
Private Sub RemoveTable(sDBName As String, sTable As String)
    Dim db As Database

    On Error GoTo Handler
    Set db = DBEngine.OpenDatabase(sDBName)
    db.Execute "drop table " & sTable
    Set db = Nothing
    Exit Sub

Handler:
    Err.Raise Err.Number, "RemoveTable", Err.Description
End Sub