Visual Basic Code of the Week (COTW)
http://www.codeoftheweek.com
Issue #66
Online Version at http://www.codeoftheweek.com/membersonly/bi/0066.html (paid subscribers only)
All content and source code is Copyright (c) 1998 by C&D Programming Corp. No part of this issue can be reprinted or distributed in any manner without express written permission of C&D Programming Corp.

Free Software

Enter our monthly contest at http://www.codeoftheweek.com/contest.html for the chance to win FREE software for your development needs.

Download an evaluation of PowerFindPro at http://www.codeoftheweek.com/powerfindpro

Late breaking information

Back issues are now available in Spanish for subscribers of Code of the Week at http://www.codeoftheweek.com/membersonly (free trial members will need to subscribe to access them).

Check out http://www.codeoftheweek.com/links/specialoffer.html for an exciting subscription offer. You do not want to miss this one.

In this Issue

This issue is the second part to last week's issue. It was designed for VB 4.0 32-bit and up and describes how to import a comma separated value (CSV) file. It uses DAO database access methods on an Access database. Questions? Email us at questions@codeoftheweek.com.

The complete source code appears near the end of this issue. Be sure not to miss it!

cImportCSV

Last week we discussed how to import any CSV file. The one problem with last week's routine is that if the first record in the CSV file did not contain field names, DAO will just assign the names F1, F2, F3, F4, etc. This week we show how to rename any columns you want after performing the import. We will assume you have read the content of issue #65. If you did not receive it, you can view it at http://www.codeoftheweek.com/issues

Functions

Public Sub RenameColumn(sOldColumnName As String, sNewColumnName As String)
Public Function ImportDataAndRename() As Long

RenameColumn allows you to specify a column from the import file (sOldColumnName) and the name (sNewColumnName) that this column should be after importing the data. The ImportDataAndRename function will use this information to change the column names in the imported table. You will need to call RenameColumn once for each column you would like to rename. Keep in mind that if your CSV file does not contain the field names as the first row, the import table will have columns called F1, F2, F3, F4, and so on starting with the first column. See the sample code for details on using RenameColumn.

ImportDataAndRename is a wrapper around the ImportData routine discussed last week. It will first call the ImportData routine and then process the OldColumnNames and NewColumnNames collections.

If the table already exists in the destination database it will remove it and overwrite it. Depending on your application you might want to change this behavior. You might want to raise an error and give the end user a choice to overwrite the table or not.

Returns

ImportDataAndRename will return the number of records that it imported. Error 457 will be returned if you try to call RenameColumn with the same column name more than once. Error 3265 will be returned if you call ImportDataAndRename and specify an non-existent column name as the sOldColumnName parameter in RenameColumn (to put another way, if you try to rename a column that does not exist).

Sample Usage

Below is an example of how this class works. It is assumed e:\temp contains the file freesub.txt to import. It also assumes the database e:\temp\importtest.mdb exists already.

    Dim Import As New cImportCSV
    Dim lRecs As Long

    Import.CSVFilePath = "e:\temp"
    Import.CSVFilename = "freesub.txt"
    Import.DatabaseName = "e:\temp\importtest.mdb"
    Import.NewTableName = "newimport"

    ' will rename column F1 to email, F11 to firstname, and F2 to lastname
    Import.RenameColumn "F1", "email"
    Import.RenameColumn "F11", "firstname"
    Import.RenameColumn "F2", "lastname"  ' will return err=457 if the names were
                                            ' already used.
    lRecs = import.ImportDataAndRename      ' will return err=3265 if you specified
                                            ' an illegal (doesn't exist) old column name

    MsgBox lRecs & " records imported."

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 does not 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

Private OldColumnNames As New Collection    ' contains the original column names
Private NewColumnNames As New Collection    ' contains the new column names

'
'   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
'
'   Will return an error if you try to rename the same column twice
'
Public Sub RenameColumn(sOldColumnName As String, sNewColumnName As String)
    Dim lCount As Long

    On Error GoTo Handler
    lCount = OldColumnNames.Count
    OldColumnNames.Add sOldColumnName, sOldColumnName
    NewColumnNames.Add sNewColumnName, sNewColumnName
    Exit Sub

Handler:
    '
    ' remove items from collection if we received an error.  We do not
    ' want to add any items unless they can both be added successfully.
    '
    If lCount <> OldColumnNames.Count Then
        OldColumnNames.Remove OldColumnNames.Count
    End If
    ' We do not forsee how we can have an extra item in this collection,
    ' but just in case we clean this up as well.
    If lCount <> NewColumnNames.Count Then
        NewColumnNames.Remove NewColumnNames.Count
    End If
    Err.Raise Err.Number, "RenameColumn", Err.Description
End Sub

Public Function ImportDataAndRename() As Long
    Dim dbImportDB As Database
    Dim lRecs As Long
    Dim tblImport As TableDef
    Dim sField As Variant
    Dim lFieldID As Long

    On Error GoTo Handler

    lRecs = ImportData
    ImportDataAndRename = lRecs

    If lRecs = 0 Then
        Exit Function
    End If

    '
    ' open the database that just received the imported file
    '
    Set dbImportDB = OpenDatabase(DatabaseName, False, False)

    ' run through each item in the collection and rename the columns
    ' as specified
    Set tblImport = dbImportDB.TableDefs(NewTableName)
    For lFieldID = 1 To OldColumnNames.Count
        tblImport.Fields(OldColumnNames.Item(lFieldID)).Name = NewColumnNames.Item(lFieldID)
    Next

    dbImportDB.Close
    Set dbImportDB = 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

'
'   clean up collections if necessary
'
Private Sub Class_Terminate()
    Dim x As Long
    If OldColumnNames.Count > 0 Then
        For x = OldColumnNames.Count To 1
            OldColumnNames.Remove x
        Next
    End If
    If NewColumnNames.Count > 0 Then
        For x = NewColumnNames.Count To 1
            NewColumnNames.Remove x
        Next
    End If
End Sub

This document is available on the web

Paid subscribers can view this issue in HTML format. There is no additional source or information in the HTML formatted document. It just looks a little better since we have included some HTML formatting. Just point your browser to link at the top of this document.

Other links

Contact Information

C&D Programming Corp.
PO Box 20128
Floral Park, NY 11002-0128
Phone or Fax: (212) 504-7945
Email: info@codeoftheweek.com
Web: http://www.codeoftheweek.com