Excel VBA Import Fixed Width Text File

[strider_svr]

I parsed the first row of the text file to create two arrays:

Dim positions() As Long
Dim position_format() As Long

I fill the arrays with starting position of each column (positions) and the column format (position_format). Next i import the text file with Fixed width positions from step 1. The code is as follows:

Sub importTextFile(positions() As Long, position_format() As Long)
        Dim ws As Worksheet
        Dim qt_Data As QueryTable
        Set ws = Worksheets("Sheet2")
        ws.Cells.Delete
        
        Set qt_Data = ws.QueryTables _
                .Add(Connection:="TEXT;C:\Users\tmp\Desktop\tmp\sample.txt", _
                Destination:=ws.Cells(1, 1))
        With qt_Data
                .FieldNames = True
                .RefreshOnFileOpen = False
                .RefreshStyle = xlInsertDeleteCells
                .AdjustColumnWidth = True
                .TextFilePromptOnRefresh = False
                .TextFilePlatform = xlWindows
                .TextFileStartRow = 1
                .TextFileParseType = xlFixedWidth
                .TextFileTextQualifier = xlTextQualifierDoubleQuote
                .TextFileConsecutiveDelimiter = False
                .TextFileColumnDataTypes = position_format ' tried putting position_format with Array(position_format)
                .TextFileFixedColumnWidths = positions ' tried putting positions with Array(positions)
                .TextFileTrailingMinusNumbers = True
                .Refresh
        End With
        Set qt_Data = Nothing
        ActiveWorkbook.Connections(ActiveWorkbook.Connections.Count).Delete
End Sub

The first column gets delimited correctly, but the other columns do not. I checked the .TextFileColumnDataType and .TextFileFixedColumnWidths. The arrays are correctly assigned (as far as i can tell - i did try using Double as my array variables - no difference):

I cannot figure out why the actual data when placed in worksheet is not split into correct column widths. Second pair of eyes would be greatly appreciated.

 

[Kenneth Hobson]

Welcome to the forum!

The argument for the querytable array inputs should be of type VARIANT I believe. When dealing with built arrays, you may need to transpose them in the call. Use Worksheetfunction.Transpose(yourArray). I have seen two transponses needed on occasion. e.g. Worksheetfunction.Transpose(Worksheetfunction.Transpose(yourArray)).

Try these ideas. If no luck, if you can post a short obfuscated example txt file to a shared site like dropbox.com or such, it is easier to help. Also, post the code where you set the widths.

 

[strider_svr]

Sorry forgot to mention that i tried Variant as my variable name. It did not make any difference. Transpose did not help as well. I uploaded a sample file to the tinyupload.com (found this place on google). The file name is: sample1.txt
this file only has 4 lines.

http://http://s000.tinyupload.com/?file_id=17811546721044018766

 

[strider_svr]

http://s000.tinyupload.com/?file_id=17811546721044018766

 

[Kenneth Hobson]

I am lazy so if you would post the code for the arrays, that would be good.

I did it another way for a user once.

Option Explicit
Public lastStr As String, colNames, colStart, colLen

'Play from the Activesheet to insert parsed text file's contents
Sub ParseMyFile()
  Dim inFile As String
  Dim iStr As String
  Dim fni As Integer
  
  On Error GoTo Cleanup
  'http://vbaexpress.com/kb/getarticle.php?kb_id=1035
  SpeedOn
'******************************** Set the path and name of the text file to parse ***********
  inFile = ThisWorkbook.Path & Application.PathSeparator & _
    "Rough data to excel.txt"
  
  If Dir(inFile) = "" Then
    MsgBox inFile & " does not exist.", vbCritical, "Macro Ending"
    GoTo Cleanup
  End If
  
  colNames = Array("Country", "CLS", "Security", "Company", "Security Name", "Currency", _
    "Market Price", "Last Price", "Market Price" & vbLf & "+ Accrued Price Rate", _
    "Price Date", "7dp")
  colStart = Array(1, 5, 9, 22, 53, 81, 85, 85, 102, 119, 129)
  colLen = Array(3, 3, 12, 30, 27, 3, 14, 14, 16, 8, 1)
  
  'Write field/column names to row 1 if A1 is empty
  If IsEmpty(Range("A1")) Then
    Range("A1").Resize(1, UBound(colNames) + 1).Value = colNames
  End If
  
  'Open inputfile.  Parse input file's parts.
  fni = FreeFile
  Open inFile For Input As #fni
  Line Input #fni, iStr
  Do While Not EOF(fni)
    'Parse lines and input to Range
    ParseLine iStr
    Line Input #fni, iStr
  Loop
  'Set formats and reset text strings to values
  SetFormats
  
Cleanup:
  On Error Resume Next
  SpeedOff
  If Err.Number <> 0 Then MsgBox "Error: " & Err.Number & vbCrLf & Err.Description, , "Error"
  Close #fni
End Sub

Sub ParseLine(str As String)
  Dim i As Integer, r As Range
  If Left(str, 5) <> "PRICE" Then
    lastStr = str
    Exit Sub
  End If
  Set r = Range("A" & Rows.Count).End(xlUp)
  For i = 0 To UBound(colNames)
    r.Offset(1, i).Value = Mid(lastStr, colStart(i), colLen(i))
  Next i
  'Reset Last Price value since it was on previous line in same position as Market Price.
  r.Offset(1, 7).Value = Mid(str, colStart(7), colLen(7))
End Sub

Sub SetFormats()
  Dim r As Range, d As Date
  'Set columns G:I as money
  Range("G2", Range("G" & Rows.Count).End(xlUp)).NumberFormat = "$#,##0.00"
  Range("H2", Range("H" & Rows.Count).End(xlUp)).NumberFormat = "$#,##0.00"
  Range("I2", Range("I" & Rows.Count).End(xlUp)).NumberFormat = "$#,##0.00"
  
  'Parse column J to make into dates and format
  For Each r In Range("J2", Range("J" & Rows.Count).End(xlUp))
    With r
     .NumberFormat = "dd-mm-yy"
     If Not (IsEmpty(r)) Then
     'Assume years are in this century
       .Value = DateSerial(2000 + Right(.Value, 2), Mid(.Value, 4, 2), Left(.Value, 2))
     End If
    End With
  Next r
End Sub


'If array is 0 based, 1 is returned if aValue matches anArray(0).
Function PosInArray(aValue, anArray)
  Dim pos As Long
  On Error Resume Next
  pos = -1
  pos = WorksheetFunction.Match(CStr(aValue), anArray, 0)
  PosInArray = pos
End Function