0
votes

I am using the following VBA code to import multiple text files in Excel. However, whenever my text files contain an empty line the content is imported into two rows, not just in one. In other words, each blank line in my text file leads to a new row being created during the import.

Example - this example text should be imported into one row in Excel:

Lorem ipsum dolor sit amet, consectetuer adipiscing elit. Aenean commodo ligula eget dolor. Aenean massa. Cum sociis natoque penatibus et magnis dis parturient montes, nascetur ridiculus mus. Donec quam felis, ultricies nec, pellentesque eu, pretium quis, sem.

Nulla consequat massa quis enim. Donec pede justo, fringilla vel, aliquet nec, vulputate eget, arcu.

However, as there is an empty line in the text, two rows are created:

Row 1:

Lorem ipsum dolor sit amet, consectetuer adipiscing elit. Aenean commodo ligula eget dolor. Aenean massa. Cum sociis natoque penatibus et magnis dis parturient montes, nascetur ridiculus mus. Donec quam felis, ultricies nec, pellentesque eu, pretium quis, sem.

Row 2:

Nulla consequat massa quis enim. Donec pede justo, fringilla vel, aliquet nec, vulputate eget, arcu.

VBA module 1:

Option Explicit

Sub Sample()
Dim myfiles As Variant
Dim i As Integer
Dim temp_qt As QueryTable
Dim ws As Worksheet

myfiles = Application.GetOpenFilename(filefilter:="Text files (*.txt), *.txt", MultiSelect:=True)

If Not IsEmpty(myfiles) Then
    Set ws = Sheet1
    For i = LBound(myfiles) To UBound(myfiles)

        Set temp_qt = ws.QueryTables.Add(Connection:= _
            "TEXT;" & myfiles(i), Destination:=ws.Range("A" & ws.Rows.Count).End(xlUp).Offset(1, 0))

         With temp_qt
            .Name = "Sample"
            .FieldNames = False
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = True
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .TextFilePromptOnRefresh = False
            .TextFilePlatform = 437
            .TextFileStartRow = 1
            .TextFileParseType = xlDelimited
            .TextFileTextQualifier = xlTextQualifierDoubleQuote
            .TextFileConsecutiveDelimiter = True
            .TextFileTabDelimiter = False
            .TextFileSemicolonDelimiter = False
            .TextFileCommaDelimiter = False
            .TextFileSpaceDelimiter = False
            .TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1)
            .TextFileTrailingMinusNumbers = True
            .Refresh BackgroundQuery:=False
        End With
    Next i
    Set temp_qt = Nothing
    CleanUpQT
Else
MsgBox "No File Selected"
End If

End Sub

VBA module 2:

Sub CleanUpQT()
Dim connCount As Long
Dim i As Long

    connCount = ThisWorkbook.Connections.Count
    For i = 1 To connCount
        ThisWorkbook.Connections.Item(i).Delete
    Next i

End Sub

How can I ensure that the entire text file is properly imported into one row, not two - no matter whether it has blank lines in it or not?

1
Are you saying each blank line leads to two blank rows in the sheet? because I see excel importing exactly as i from the txt file (with offset 1 as defined) - Krishna
Each blank line leads to a new row in Excel. However, the whole text should be imported into one row / cell only. - Alex

1 Answers

1
votes

One method for accomplishing this is to simply load the text files into memory. This method won't trigger Excel's automatic import functionality, and will allow you to prevent linebreaks from splitting the documents into multiple rows.

See the following example:

Sub Sample()
    Dim myFiles As Variant
    Dim i As Integer
    Dim ws As Worksheet
    Dim myData As String

    myFiles = Application.GetOpenFilename( _
        filefilter:="Text files (*.txt),*.txt", _
        MultiSelect:=True)

    If IsArray(myFiles) Then
        Set ws = Sheet1
        For i = LBound(myFiles) To UBound(myFiles)
            Open myFiles(i) For Binary As #1 ' Open the file
            myData = Space$(LOF(1))          ' Allocate space for the file contents
            Get #1, , myData                 ' Read the file into the string
            Close #1                         ' Close the file

            ws.Range("A" & ws.Rows.Count).End(xlUp).Offset(1, 0).Value = myData
        Next i
    Else
        MsgBox "No File Selected"
    End If  
End Sub