Импорт текстовых файлов с пустой строкой?

Question

Я использую следующий код VBA для импорта нескольких текстовых файлов в Excel. Однако, всякий раз, когда в текстовых файлах содержится пустая строка, содержимое импортируется в две строки, а не только в одну. Другими словами, каждая пустая строка в текстовом файле приводит к созданию новой строки во время импорта.

Пример - этот пример текст должен быть импортированы в один строки в Excel:

Lorem Ipsum Dolor сидеть Амет, consectetuer adipiscing Элит. Aenean como 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 ensat massa quis enim. Donec pede justo, fringilla vel, aliquet nec, vulputate eget, arcu.

Однако, так как есть пустая строка в тексте, две строки созданы:

Ряд 1:

Lorem Ipsum боль сидеть Амет, consectetuer adipiscing Элит. Aenean como 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.

Строка 2:

Nulla consequat Massa Quis enim. Donec pede justo, fringilla vel, aliquet nec, vulputate eget, arcu.

модуль VBA 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 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 

Как я могу гарантировать, что весь текстовый файл не правильно импортировать в один ряд, а не две - независимо от того, является ли в нем есть пустые строки или нет?

Answer 1

Один из способов достижения этого - просто загрузить текстовые файлы в память. Этот метод не будет запускать функции автоматического импорта Excel и позволит вам предотвратить разрывы строк в разных столбцах.

Смотрите следующий пример:

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