Text to Columns macro help - use comma as delimiter with commas embedded in fields and retain text qualifier

[jeff_cp]

I'm building a macro / button to import a cap file (simply a txt file renamed to a a file extension of cap) that contains 68 fields, separated by commas. These fields are a mix of numeric and string values and some string values contain commas embedded. The string fields are wrapped in quotes.

What I'm trying to do is split the fields into 68 separate columns, ignoring commas that are in fields wrapped in quotes and retain the text qualifiers for string fields. Currently, I can retain the text qualifiers but if there are commas embedded in the string fields, it's splitting those fields on every comma, which is throwing off the columns.

Is this possible?

This is what I have thus far:

Sub ImportINVENT_CAP()
Dim fName As String, LastRow As Long

Sheets("INVENT.CAP").Select
    Range("B18").Select

fName = Application.GetOpenFilename("Cap Files (*.cap), *.cap")
If fName = "False" Then Exit Sub

LastRow = Range("B" & Rows.Count).End(xlUp).Row + 1

    With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & fName, _
        Destination:=Range("B" & LastRow))
            .Name = "sample"
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .TextFilePromptOnRefresh = False
            .TextFilePlatform = 437
            .TextFileStartRow = 1
            .TextFileParseType = xlDelimited
            .TextFileTextQualifier = xlTextQualifierNone
            .TextFileConsecutiveDelimiter = False
            .TextFileTabDelimiter = False
            .TextFileSemicolonDelimiter = False
            .TextFileCommaDelimiter = True
            .TextFileSpaceDelimiter = False
            .TextFileColumnDataTypes = Array(2, 2, 2, 1, 1, 2, 1, 1, 2, 2, 2, 2, 1, 2, 2, 1, 2, 2, 2, 1, 1, 2, 2, 2, 2, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 1, 2, 1, 1, 1, 1, 2, 2, 2, 1, 2, 2, 2, 1, 2, 2, 2, 2, 1, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2, 2)
            .TextFileTrailingMinusNumbers = True
            .Refresh BackgroundQuery:=False
        End With

 

[Logit]

That simplifies things greatly !

Here are the macros that will process your CAP file as desired :

Option Explicit

'EDIT THE PATHS BELOW TO MATCH YOUR COMPUTER
    
Sub RenameFile()
  Name "C:\Users\jimga\Desktop\INVENT.CAP" As "C:\Users\jimga\Desktop\INVENT.TXT"

TextFileLoad

End Sub

Sub TextFileLoad()
    Dim fn As Integer
    Dim MyData As String
    Dim lineData As String, strData() As String, myFile As String
    Dim i As Long, rng As Range

    myFile = Application.GetOpenFilename("Text Files (*.*), *.*")

    Set rng = Range("A1")

    ' Lets not rely on Magic Numbers
    fn = FreeFile
    Open myFile For Input As #fn
    i = 1
    Do While Not EOF(fn)
        Line Input #fn, lineData
        strData = Split(lineData, ",")
        rng.Cells(i, 1).Resize(1, UBound(strData) + 1) = strData
        i = i + 1
    Loop
    Close #fn
    
DeleteEmptyColumns
    
End Sub

'==========================================
' Delete Empty Columns
'==========================================
Sub DeleteEmptyColumns()
   Sheet1.Range("K:L, U:X, AD:AD, AJ:AV, AX:AY,BB:BC, BE:BE, BG:BG, BI:BR, BT:BV").Delete
   Columns("A:AZ").EntireColumn.AutoFit
End Sub

NOTICE : You will need to edit this line of code to match your system.

Name "C:\Users\jimga\Desktop\INVENT.CAP" As "C:\Users\jimga\Desktop\INVENT.TXT"

NOTICE : The following line assumes you are using Sheet1 as the depository for your data from the CAP file. If it is not Sheet1, edit that line of code as well to match
your system.

Sheet1.Range("K:L, U:X, AD:AD, AJ:AV, AX:AY,BB:BC, BE:BE, BG:BG, BI:BR, BT:BV").Delete

Also, I separated the various steps into individual macros so you can follow the logic.

Download workbook : CAP File Convert.xlsm

 

[Marc L]

Is this possible?

Yes with the help of the Macro Recorder and just well answering to the Import assistant obviously in particular for the text qualifier :​

Sub Macro1()
  Const S = "INVENT.CAP"
    Dim V
        V = Application.GetOpenFilename("Cap Files, *.cap"):  If V = False Then Exit Sub
    With Sheets(S).QueryTables.Add("TEXT;" & V, Sheets(S).Cells(Rows.Count, 2).End(xlUp)(2))
        .RefreshStyle = 0
        .TextFileCommaDelimiter = True
        .TextFileDecimalSeparator = "."
        .Refresh False
        .Delete
    End With
End Sub