Solved

CSV Import and Transpose into Access

Posted on 2014-02-26
5
1,053 Views
Last Modified: 2014-03-26
I have searched the net and really haven't found and elegant solution for this. So i thought i would ask the experts.

I have a csv file that i receive from a mobile app. I have no control of the how the csv file is created. The csv file has 750 columns and two rows of data.

First row data are the field names ( or QuestionLabels) from the mobile app.

The second row of data is the answers to these questions.

the first row i am able to split easy enough. It's the second row of data that has me baffled. Here is why.

the csv file as you know is comma delimited, so when the answer itself has additional commas the split function thinks it's another field. So for example if i have data as such.


Replace Door, 350,"Install Trim, Locks and paint", 1,250.00, White

i get

Replace Door
350
"Install  Trim
Lock and Paint"
1
250.00
white

as my split data.

I am trying to transpose the two row into two columns in a temp table in my access database. I have posted my code below.

Any suggestions please.


Sub parse_csv()
Dim fd As FileDialog
Dim Question() As String
Dim Answer() As String
Dim x, y
Dim i As Integer, c As Integer, Ifilenum As Integer
Dim sFilename As String, sAText As String, sQText As String
   
Set fd = Application.FileDialog(msoFileDialogFilePicker)
With fd
    .InitialFileName = Environ("USERPROFILE") & "\Desktop\247\Pronto\"
    .InitialView = msoFileDialogViewList
    .AllowMultiSelect = False
    .Title = "Please browse for your *.csv data file"
    .Filters.Clear
    .Filters.Add "csv files", "*.csv"
    .Filters.Add "Text files", "*.txt"
    If .Show = True Then
        sFilename = .SelectedItems(1)
    End If
End With
   
If sFilename = "" Then Exit Sub

Set fd = Nothing

CurrentProject.Connection.Execute "Delete * From TempCSV"

Ifilenum = FreeFile()
Open sFilename For Input As Ifilenum
    Line Input #Ifilenum, sQText
        Question = Split(sQText, ",")
   
    Line Input #Ifilenum, sQText
        Answer = Split(sQText, "~")
           
        For i = 0 To UBound(Question)
            x = padQuotes(Question(i))
            y = padQuotes(Answer(i))
            If Not Right(x, 4) = "PICS" Then
                CurrentProject.Connection.Execute "Insert Into TempCSV (QuestionLabel, QuestionAnswer) Values ('" & x & "','" & y & "')"
            End If

        Next i
End Sub
0
Comment
Question by:jb702
  • 2
5 Comments
 
LVL 22

Expert Comment

by:rspahitz
ID: 39891018
Maybe you can use  the built-in command to import text data?

    Const Spec_Name As String = "specname"
    Const Destination_Table As String = "destination_table"
    Const File_Name As String = "c:\somefile.csv"
    Const Has_Field_Names As Boolean = True ' <= make false if there are no headings in the file
   
    DoCmd.TransferText acImportFixed, Spec_Name, Destination_Table, File_Name, Has_Field_Names

Since your file is comma-delimited, you can probably omit the Spec_Name variable (or value)

so starting after you Delete * command, add this:

    Const Spec_Name As String = ""
    Const Destination_Table As String = "TempCSV "
    'Const File_Name As String = "c:\somefile.csv"
    Const Has_Field_Names As Boolean = True
    DoCmd.TransferText acImportFixed, Spec_Name, Destination_Table, sFilename, Has_Field_Names


Does that help?
0
 
LVL 92

Expert Comment

by:Patrick Matthews
ID: 39891775
rspahitz,

I thought about using TransferText as well, but won't that hit the wall on Access's limit of 255 fields per table?

Patrick
0
 
LVL 92

Accepted Solution

by:
Patrick Matthews earned 500 total points
ID: 39891912
The following works by using Excel to open and parse the CSV file, transpose it, and save it as a new flat file that gets imported.  Note that this will only work if the user has Excel 2007 or later installed: Excel 2003 and earlier has a column limit of 256.

Sub ImportCSV()
    
    Dim xlApp As Object 'Excel.Application
    Dim xlWb1 As Object 'Excel.Workbook
    Dim xlWb2 As Object 'Excel.Workbook
    Dim SourcePathAndName As Variant
    Dim SourcePath As String
    Dim SourceName As String
    Dim NewNameAndPath As String
    
    Const xlPasteValues As Long = -4163
    Const xlCSV As Long = 6
    
    Set xlApp = CreateObject("Excel.Application")
    SourcePathAndName = xlApp.GetOpenFilename("CSV Files (*.csv), *.csv", , "Select source file...", , False)
    If SourcePathAndName = False Then
        MsgBox "No file selected", vbCritical, "Aborting"
        GoTo Cleanup
    End If
    
    SourcePath = Left(SourcePathAndName, InStrRev(SourcePathAndName, "\"))
    SourceName = Mid(SourcePathAndName, InStrRev(SourcePathAndName, "\") + 1)
    NewNameAndPath = SourcePath & "Import-" & SourceName
    
    xlApp.DisplayAlerts = False
    Set xlWb1 = xlApp.Workbooks.Open(SourcePathAndName)
    
    xlWb1.Worksheets(1).UsedRange.Copy
    Set xlWb2 = xlApp.Workbooks.Add
    With xlWb2.Worksheets(1)
        .[a1:b1] = Array("QuestionText", "QuestionResponse")
        .[a2].PasteSpecial Paste:=xlPasteValues, Transpose:=True
    End With
    
    xlWb2.SaveAs NewNameAndPath, xlCSV
    xlWb2.Close False
    xlWb1.Close False
    
    xlApp.DisplayAlerts = True
    
    DoCmd.TransferText acImportDelim, "ResponseImport", "tblQuestionResponses", NewNameAndPath, True
    Kill NewNameAndPath
    
    MsgBox "Done"
    
Cleanup:
    Set xlWb1 = Nothing
    Set xlWb2 = Nothing
    xlApp.Quit
    Set xlApp = Nothing
    
End Sub

Open in new window


The following sample files may be helpful.  The CSV file is a phony import file.
Q-28375713.csv
Q-28375713.mdb

Patrick
0
 
LVL 45

Expert Comment

by:Martin Liss
ID: 39955440
This question has been classified as abandoned and is closed as part of the Cleanup Program. See the recommendation for more details.
0

Featured Post

Get up to 2TB FREE CLOUD per backup license!

An exclusive Black Friday offer just for Expert Exchange audience! Buy any of our top-rated backup solutions & get up to 2TB free cloud per system! Perform local & cloud backup in the same step, and restore instantly—anytime, anywhere. Grab this deal now before it disappears!

Join & Write a Comment

When trying to find the cause of a problem in VBA or VB6 it's often valuable to know what procedures were executed prior to the error. You can use the Call Stack for that but it is often inadequate because it may show procedures you aren't intereste…
A simple tool to export all objects of two Access files as text and compare it with Meld, a free diff tool.
In Microsoft Access, learn different ways of passing a string value within a string argument. Also learn what a “Type Mis-match” error is about.
Access reports are powerful and flexible. Learn how to create a query and then a grouped report using the wizard. Modify the report design after the wizard is done to make it look better. There will be another video to explain how to put the final p…

762 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

17 Experts available now in Live!

Get 1:1 Help Now