Mass Import of CSV Files

[watdahek]

I have a folder that has one csv file for each day of a specific month. I have code to run through all files and import them into an Access table. There are a few rows of data that have numbers greater than 1,000 and use commas. These data points keep kicking out as import errors. I already created a specification that uses " as the text qualifier but it still errors out. The code looks like this:

Sub Load_DMAPPS()

Dim strFileName As String
Dim strPath As String
strPath = "N:\Data\DMAPPS\2011\01-Jan\"
strFileName = Dir(strPath & "*.csv")
Do While strFileName <> vbNullString
DoCmd.TransferText acImportDelim, DMAPPSImport, "DMAPPS", strPath & strFileName, True
strFileName = Dir()
Loop

End Sub

Any help would be appreciated.

Thanks,
Steve

 

[Phildaburn]

The comma is forcing Access to treat the entry as text rather than a number. Is this column in the same place such that if you were to open the file in Excel you could programmatically select that column and change the format of it before importing it into Access?

Phil...

 

[watdahek]

Yes, the issue has the potential to occur in the same 4 columns of any of the files. I was trying to avoid that due to time implications of having to open, modify and save each file? They are fairly large files and I am looking to run this code for 2 years worth of data. If this is the best solution I guess I will have to suck it up and deal. Would you have sample code to do this?

Thanks,
Steve

 

[Joe4]

If you have text qualifiers around the entries with commas that are not delimiters, than it should work. That is, if you Import Specification File indicates that text delimiters are used and what they are.

If not, you should be able to update the Import Spec pretty easily, then it should work.

 

[watdahek]

OK, I got it now. Phil is correct Access was seeing the numbers with commas as text causing the data to kick out as a Type Conversion error. So I created 2 tables one to import the data as text and then I created an append query to copy the data to another table with the correct data type.

Thanks you both for your help,
Steve

 

[Phildaburn]

If this task were mine to accomplish, I would first run a function to create a table filled with the names of all these CSV files. Then, using that table of file names, open each one in Excel, run a macro to alter those columns, save the results, then import the file into Access. Here's some sample code that I've modified slightly from what I use (so it is untested and needs more modifications) that imports file names into a table:

Function ImportFiles()
'Declare variables
Dim fso 'File system object
Dim GetFile, FilDate 'to get the particular data file
Dim FilCount, FrmFolder
Dim db As Database
Dim tbdef As New TableDef 'to assign this for NewTable
Dim ColltbDef As TableDefs 'to search for tables collection with the name NewTable
Dim FilColl 'File collection
Dim tblFileNames As TableDef
Set db = CurrentDb 'set the database to be current database
Set fso = CreateObject("Scripting.FileSystemObject")
'Set FrmFolder = fso.GetFolder("\\ Server & Path") 'TEST setting the folder where the label files are located
Set FrmFolder = fso.GetFolder("\\ Server & Path") 'PRODUCTION setting the folder where the label files are located
Set FilColl = FrmFolder.Files
Dim Ctr, ID As Integer
Dim rsCur, rs, rs1, rs2 As Recordset
Dim lblFile, lblExt, PCC, Cus1, Copies, Seq, NewQry1, NewQry2, ForQry, MainQry, ToTable1, ToTable2 As String
Dim lblDate As Date
Dim relNew As Relation
Dim fld As Field
Dim rtncode As Long
Dim UpdateFld, UpdatingFld
Ctr = 1
Dim qry As QueryDef
Dim cnt
'Creating FileNames Table to enable storage of new file information
Set tblFileNames = db.CreateTableDef("FileNames")
With tblFileNames
.Fields.Append .CreateField("ID", dbLong)
.Fields.Append .CreateField("FileName", dbText)
.Fields.Append .CreateField("Ext", dbText)
.Fields.Append .CreateField("DateModified", dbDate)
.Fields("ID").Attributes = dbAutoIncrField
End With
db.TableDefs.Append tblFileNames
db.Execute "CREATE UNIQUE INDEX ID on RenewalFileNames(ID) WITH PRIMARY; "
Set rs = db.OpenRecordset("FileNames")

For Each FilCount In FilColl
lblFile = fso.GetFileName(FilCount)
lblDate = FilCount.DateLastModified
lblExt = fso.GetExtensionName(FilCount)
' Modify this next line in order to select the files you want imported
If Left(lblFile, 8) = "renewal_" And DateDiff("d", lblDate, Date) < 7 Then
Call rsUpdate(rs, lblFile, lblExt, lblDate)
End If

Next
If rs.RecordCount < 1 Then
MsgBox "No files found. "
Screen.MousePointer = 0
End
End If


'Deal with the Files one at a time...
rs.MoveFirst

' new code for importing files
Do While Not rs.EOF
Dim fs, fn
fs = FrmFolder & "\"
fn = fs & rs.Fields("FileName").Value

'
' Code to open the PERSONAL.XLSB file and execute an Excel Macro
'
'call xlsOpenMacroSheet() Code should be modified to pass the file name as a variable to Excel
'
'The Excel macro then calls another Excel macro that opens the file. If that is successful, it calls a macro that you can record in Excel to make the changes you want done to each file. It saves and closes Excel upon completion.

DoCmd.TransferText acImportDelim, "ImportSpec", "Renewal", fn
rs.MoveNext
Loop

End Function
Function rsUpdate(rs, lblFile, lblExt, lblDate)
With rs
.AddNew
.Fields("FileName").Value = lblFile
.Fields("Ext").Value = lblExt
.Fields("DateModified").Value = lblDate
.Update
End With

End Function

'This is in Access
Function xlsOpenMacroSheet()
Dim xlsApp As Excel.Application
Dim xlsWkb As Excel.Workbook
'C:\Users\tdistin\AppData\Roaming\Microsoft\Excel\XLSTART\PERSONAL.XLSB
Const TARGET_WB = "C:\Users\tdistin\AppData\Roaming\Microsoft\Excel\XLSTART\PERSONAL.XLSB"
Set xlsApp = CreateObject("Excel.Application")
<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o> </o>
xlsApp.Visible = True
<o> </o>
Set xlsWkb = xlsApp.Workbooks.Open(TARGET_WB)
<o> </o>
xlsApp.Application.Run "PERSONAL.XLSB!RunExcelMacro"
xlsApp.Quit
End Function


'This is in Excel
'It needs to be modified so that it passes the file name
Public Function RunExcelMacro() As Boolean
Dim s As String
Dim wb As Workbook
Dim ws As Worksheet
<o> </o>
On Error GoTo ErrHandler:
'
'This next line - I've replaced a file name like "C:\MyFolder\MyFilename" with a FileName variable
Set wb = Workbooks.Open(FileName)
Application.Run "PERSONAL.XLSB!RunExcelChanges"

'//We seem to have survived errors. Return True
RunExcelMacro = True
<o> </o>
'//close any workbooks you opened
My_Exit:
If Not wb Is Nothing Then
wb.Close SaveChanges:=True
End If
Exit Function
<o> </o>
ErrHandler:
RunExcelMacro = False
Resume My_Exit
<o> </o>
End Function
<o> </o>


Sub RunExcelChanges()
'
'Recorded macro tasks/formatting changes
'
End Sub

It's long - sorry - and totally untested. I hope it helps.

Phil...