导入带有空行的文本文件?

Importing text files with blank line?

我正在使用以下 VBA 代码在 Excel 中导入多个文本文件。但是,每当我的文本文件包含一个空行时,内容就会被导入两行,而不仅仅是一行。换句话说,我的文本文件中的每个空行都会导致在导入过程中创建一个新行。

示例 - 此示例文本应导入到 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.

但是,由于文本中有一个空行,因此创建了 行:

第 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.

第 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

如何确保将整个文本文件正确导入一行,而不是两行 - 无论其中是否有空行?

完成此操作的一种方法是将文本文件简单地加载到内存中。此方法不会触发 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