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