您可以使用Workbooks.OpenText方法-我认为这更易于管理

Sub Tester()

    Dim wb As Workbook
    
    Set wb = GetWorkbook("C:\Temp\pipes.txt")
    
    Debug.Print wb.Name

End Sub

Function GetWorkbook(fpath) As Workbook
    Workbooks.OpenText Filename:=fpath, Origin:=437, StartRow:= _
        1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
        ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:=False _
        , Space:=False, Other:=True, OtherChar:="|", TrailingMinusNumbers:=True
    Set GetWorkbook = ActiveWorkbook
End Function

您选择的是此行代码中的第一列。

Set r = Range(Range("A1"), Range("A1").End(xlDown))

如果文件是由竖线符号分隔的文本，这应该是可以的。但是，如果文件中有逗号，它会自动将逗号后面的数据分成另一列。
尝试直接以文本模式打开文件。
举例来说

Workbooks.OpenText Filename:="C:\Temp\Test1.txt", _
    Origin:=xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
    xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False _
    , Comma:=False, Space:=False, Other:=True, OtherChar:="|", FieldInfo _
    :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1)), _
    TrailingMinusNumbers:=True

我有个办法

Option Explicit
Dim theDir As String, wk As Workbook, numFiles As Integer, s As String, r As Range
Const ext = ".txt"

Sub LoopThroughFiles()
    Dim xFd As FileDialog
    Dim xFdItem As Variant
    Dim xFileName As String
    theDir = ThisWorkbook.Path
    Dim wkbpath As String
    Dim wkbname As String
    Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
    If xFd.Show = -1 Then
        xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
        xFileName = Dir(xFdItem) ' old version had: & "*.txt*")
        Do While xFileName <> ""
            With Workbooks.Open(xFdItem & xFileName)
                'your code here
                    Set r = Range(Range("A1"), Range("A1").End(xlDown))
                    r.TextToColumns Destination:=r, DataType:=xlDelimited, _
                    TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
                    Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar:="|", _
                    FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
                        Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1 _
                        ), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array _
                        (20, 1), Array(21, 1), Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), _
                        Array(27, 1), Array(28, 1), Array(29, 1), Array(30, 1), Array(31, 1), Array(32, 1), Array( _
                        33, 1), Array(34, 1), Array(35, 1), Array(36, 1), Array(37, 1), Array(38, 1), Array(39, 1), _
                        Array(40, 1), Array(41, 1), Array(42, 1), Array(43, 1), Array(44, 1), Array(45, 1), Array( _
                        46, 1), Array(47, 1), Array(48, 1), Array(49, 1), Array(50, 1), Array(51, 1), Array(52, 1), _
                        Array(53, 1), Array(54, 1), Array(55, 1), Array(56, 1), Array(57, 1), Array(58, 1), Array( _
                        59, 1), Array(60, 1), Array(61, 1), Array(62, 1), Array(63, 1), Array(64, 1)), TrailingMinusNumbers:=True
                    Application.DisplayAlerts = False
                    Cells.Select
                        Selection.AutoFilter
                        Application.AddCustomList ListArray:=Array("PREFERRED", "NON-PREFERRED", _
                            "UNACCEPTABLE", "OBSOLETE")
                        ActiveSheet.Sort.SortFields. _
                            Clear
                        ActiveSheet.Sort.SortFields. _
                            Add Key:=Range("D2:D479"), SortOn:=xlSortOnValues, _
                            CustomOrder:="PREFERRED,NON-PREFERRED,UNACCEPTABLE,OBSOLETE", DataOption:= _
                            xlSortNormal
                        With ActiveSheet.Sort
                            .SetRange Range("A1:BH79")
                            .Header = xlYes
                            .MatchCase = False
                            .Orientation = xlTopToBottom
                            .SortMethod = xlPinYin
                            .Apply

            xFileName = Dir
            
            wkbpath = "C:\Users\tomas.breitinger\Desktop\BAE Export .DAT Files\Finished\"
            wkbname = ActiveWorkbook.Name
            ActiveWorkbook.SaveAs Filename:= _
            wkbpath & wkbname & ".xlsx", FileFormat:=51, CreateBackup:=False
            ActiveWorkbook.Close savechanges:=False
            End With
              End With
        Loop
    End If
End Sub