loop though csv file, zipcode error

[supmktg]

Using VBA, I'm trying to loop through a dao.recordset based on a csv file. The file contains a zipcode field that may contain 5 digits like 11111 or sometimes a plus 4 like 11111-1111. The field in the recordset is being formatted as numeric, and I am getting an overflow error when it loops to a record with a 11111-1111 entry.

I have tried importing or linking the file via transfer spreadsheet and I get the same error. I have tried converting the file to xls first and again I get the same result/error.

This file will have a different set of fields each time I import it, so I can't set up an import specification. I've looked all over and can't find a solution.

The closest that I have come is using the Open File for Input method which unfortunately I am unfamiliar with. Ultimately, I will be parsing and manipulating this data for use elsewhere, and an all text table from the csv file would work.

Can someone help me with a function that will turn a csv file into a table and force all fields to be text?

Thanks,
Sup

 

[ChrisO]

Try:-

Sub TestImport()

    ImportCSV2Table "C:\Temp\Test.csv", "tblTest"

End Sub


Sub ImportCSV2Table(ByVal strSourceFile As String, _
                    ByVal strTableName As String)
                   
    Dim intFileIn     As Integer
    Dim intIndex      As Integer
    Dim strTextLine   As String
    Dim strSQL        As String
    Dim vntFieldNames As Variant

    ' Drop table if it exists.
    On Error Resume Next
        CurrentDb.Execute "DROP TABLE [" & strTableName & "]"
    On Error GoTo ErrorHandler

    ' Get Header line.
    intFileIn = FreeFile()
    Open strSourceFile For Input As intFileIn
    Line Input #intFileIn, strTextLine
    
    strSQL = "CREATE TABLE [" & strTableName & "] ("
    
    ' Get Field names from Header and build 'CREATE TABLE' string.
    vntFieldNames = Split(strTextLine, ",")
    For intIndex = LBound(vntFieldNames) To UBound(vntFieldNames)
        strSQL = strSQL & "[" & Trim(vntFieldNames(intIndex)) & "] Text(255),"
    Next intIndex
    strSQL = Left(strSQL, Len(strSQL) - 1) & ")"
    
    ' Create Table.
    CurrentDb.Execute strSQL
    
    ' Fill Table based on ordinal position.
    With CurrentDb.OpenRecordset(strTableName, 2)
        Do While Not EOF(intFileIn)
            Line Input #intFileIn, strTextLine
            
            vntFieldNames = Split(strTextLine, ",")
            .AddNew
                For intIndex = LBound(vntFieldNames) To UBound(vntFieldNames)
                    .Fields(intIndex) = Trim(vntFieldNames(intIndex))
                Next intIndex
            .Update
        Loop
    End With

ExitProcedure:
    On Error Resume Next
    Close #intFileIn
    Exit Sub
    
ErrorHandler:
    MsgBox "Error: " & Err.Number & " - " & Err.Description
    Resume ExitProcedure

End Sub

If that doesn’t work, can you post a small sample of one of the CSV files?

Chris.

 

[Simon_MT]

The Zip code also includes the State Code so SC-nnnnn-nnnn is the correct format and Zip/Postcode must be a string field. You just need to go across the border to find a totally different format.

Simon

 

[supmktg]

Hi Chris,

Your code does exactly what I was trying to do!

Unfortunately, some records get added and some produce an error 3265 - item not found in this collection.

I tried to weed out what was causing the error, but I can't find anything that is obvious. There is a record that has a line feed in one field, but that doesn't seem to be the problem.

I've attached a small sample csv file including some records that error and some that don't.

I really appreciate your help,
Sup

 

[ChrisO]

I can see where the problem is but it will take some time to fix it.

Technically speaking the text file is not a CSV (Comma Separated Value) file in that the values are not separated by commas. Some of the values contain commas, street address for example, and that means that the record actually contains more than 28 'values' separated by commas for that row.

However, it appears that any 'value' containing a comma is surrounded by double quotes.
That may be enough to parse out those values but it might take some time to do it.

Leave it with me and I’ll see what I can do.

Chris.

 

[ChrisO]

New version:-

Sub TestImport()

    ImportCSV2Table "C:\Temp\TestCSVFile.csv", "tblTest"

End Sub


Sub ImportCSV2Table(ByVal strSourceFile As String, _
                    ByVal strTableName As String)
                   
    Dim intFileIn     As Integer
    Dim intIndex      As Integer
    Dim strTextLine   As String
    Dim strSQL        As String
    Dim vntFieldNames As Variant

    [color=green]' Drop table if it exists.[/color]
    On Error Resume Next
        CurrentDb.Execute "DROP TABLE [" & strTableName & "]"
    On Error GoTo ErrorHandler

    [color=green]' Get Header line.[/color]
    intFileIn = FreeFile()
    Open strSourceFile For Input As intFileIn
    Line Input #intFileIn, strTextLine
    
    [color=green]' Replace embedded Commas with Pipes.[/color]
    strTextLine = ReplaceCommaWithPipe(strTextLine)
    
    strSQL = "CREATE TABLE [" & strTableName & "] ("
    
    [color=green]' Get Field names from Header and build 'CREATE TABLE' string.[/color]
    vntFieldNames = Split(strTextLine, ",")
    For intIndex = LBound(vntFieldNames) To UBound(vntFieldNames)
        [color=green]' Replace Pipe with Comma in field name.[/color]
        strSQL = strSQL & "[" & Trim(Replace(vntFieldNames(intIndex), "|", ",")) & "] Text(255),"
    Next intIndex
    strSQL = Left(strSQL, Len(strSQL) - 1) & ")"
    
    [color=green]' Create Table.[/color]
    CurrentDb.Execute strSQL
    
    [color=green]' Fill Table based on ordinal position.[/color]
    With CurrentDb.OpenRecordset(strTableName, 2)
        Do While Not EOF(intFileIn)
            Line Input #intFileIn, strTextLine
            
            [color=green]' Replace embedded Commas with Pipes.[/color]
            strTextLine = ReplaceCommaWithPipe(strTextLine)
            
            vntFieldNames = Split(strTextLine, ",")
            .AddNew
                For intIndex = LBound(vntFieldNames) To UBound(vntFieldNames)
                    [color=green]' Replace Pipe with Comma and save field data.[/color]
                    .Fields(intIndex) = Trim(Replace(vntFieldNames(intIndex), "|", ","))
                Next intIndex
            .Update
        Loop
    End With

ExitProcedure:
    On Error Resume Next
    Close #intFileIn
    Exit Sub
    
ErrorHandler:
    MsgBox "Error: " & Err.Number & " - " & Err.Description
    Resume ExitProcedure

End Sub


Private Function ReplaceCommaWithPipe(ByVal strIn As String) As String
    Dim intPos  As Integer
    Dim strTemp As String
    
    For intPos = 1 To Len(strIn)
        If Mid(strIn, intPos, 1) = Chr(34) Then
            intPos = intPos + 1
            
            While Mid(strIn, intPos, 1) <> Chr(34)
                If Mid(strIn, intPos, 1) = "," Then
                    Mid(strIn, intPos, 1) = "|"
                End If
                
                strTemp = strTemp & Mid(strIn, intPos, 1)
                intPos = intPos + 1
            Wend
        Else
            strTemp = strTemp & Mid(strIn, intPos, 1)
        End If
    Next intPos
    
    ReplaceCommaWithPipe = strTemp

End Function

Chris.

 

[supmktg]

Hi Chris,

Thank you so much! It works perfectly!

I appreciate your help,
Sup