使用VBA从Excel中的txt文件导入数据，需要从标题中部分提取

如何解决使用VBA从Excel中的txt文件导入数据，需要从标题中部分提取

我正在使用以下vba代码从1个Excel工作表中的多个txt文件（以竖线'|'字符分隔）中导入数据：

Sub LoopFiles()

'Variable Declaration
Dim sFilePath As String
Dim sFileName As String

'Specify File Path
sFilePath = Application.ActiveWorkbook.Path

'Check for back slash
If Right(sFilePath,1) <> "\" Then
    sFilePath = sFilePath & "\"
End If
    
sFileName = Dir(sFilePath & "*.txt")


Do While Len(sFileName) > 0
    If Right(sFileName,3) = UCase("txt") Then
        'Display file name in immediate window
        'Debug.Print sFileName
        rNum = LastRowColumn(Application.ActiveSheet)
        Call ImportPipeDelimited(sFilePath,sFileName,rNum + 1)
    End If
    'Set the fileName to the next available file
    sFileName = Dir
Loop

End Sub

Sub ImportPipeDelimited(filePath As String,fileName As String,rowNum)
  With ActiveSheet.QueryTables.Add(Connection:= _
    "TEXT;" & filePath & fileName,Destination:=Range("A" & rowNum))
    .TextFileParseType = xlDelimited
    .TextFileOtherDelimiter = "|"
    .TextFileColumnDataTypes = Array(1,9,1,9)
    .Refresh BackgroundQuery:=False
  End With

 Dim ws As Worksheet: Set ws = Application.ActiveSheet


 Dim qrytblQueryTable As QueryTable
    For Each qrytblQueryTable In ws.QueryTables
        qrytblQueryTable.Delete
    Next qrytblQueryTable
 End Sub

上面的代码正在执行预期的操作，它从文件夹中的txt文件导入所有相关数据。

问题：每个txt文件中都有标头，其中包括用户名，公司名称和部门，如下所示：

GLD740 --------------------------------- ABC PVT LIMITED ---------- ------------------------质量控制

上面的

破折号实际上不是txt文件数据的一部分，我实际上将它们放置为代表空格，出于某些原因，编辑器不允许这样做。

上面的标头与所有txt文件一起导入到一个excel单元格中（这是预期的，因为它没有用任何已知的字符模式定界），是否有任何解决方案可以使用vba提取部门名称（在右侧）码？请注意，部门名称的长度不同，例如生产部门，财务，管理员等

非常感谢任何帮助/建议/解决方案。

谢谢。

解决方法

我认为正确的功能可以做到这一点。与InStrRev结合使用，您应该得到想要的东西。

Sub ReadTextFileExample()
    Dim sFileName As String: sFileName= 'directory where the file is
    Dim strTextLine As String
    Dim iFile As Integer: iFile = FreeFile
    Open sFileName For Input As #iFile
    Line Input #1,strTextLine
    company_name= Right(strTextLine,Len(strTextLine) - InStrRev(strTextLine," 
",vbTextCompare))
    Close #iFile
End Sub