excel - 导入文本文件内容和文本文件名称，然后使用宏分隔到 Excel

Question

由于使用宏将文本文件内容和文本文件名称导入 Excel，我有此代码

Option Explicit

Sub Import_video_txt_files()

    ' ADD REFERENCE TO MICROSOFT FILE SYSTEM OBJECT

    Dim objFSO As FileSystemObject
    Dim objFolder As folder
    Dim objFile As file
    Dim objTextStream As TextStream
    Dim strPath As String
    Dim i As Long

    ' Specify the folder...
    strPath = "C:\Users\User\Desktop\TEST\"

    ' Use Microsoft Scripting runtime.
    Set objFSO = New FileSystemObject
    Set objFolder = objFSO.GetFolder(strPath)

    ' Check extension of each file in folder.
    For Each objFile In objFolder.Files
        If objFSO.GetExtensionName(objFile.Name) = "txt" Then
            Cells(i + 2, 1) = objFile.Name
            Set objTextStream = objFile.OpenAsTextStream(ForReading)
            Cells(i + 2, 2) = objTextStream.ReadAll
            i = i + 1
        End If
    Next
End Sub

但是现在我需要扩展功能。

文本文件在一行中包含所有信息。

例如：灰色、红色、蓝色|408.95|14165.849841859

我正在使用这个分隔符|

我希望能够从文本文件中导入所有信息并使用|将它们分开。并将它们放入相应的单元格中，如下图所示。

标签： excelvba

Answer 1

尝试，

Sub Import_video_txt_files()

    ' ADD REFERENCE TO MICROSOFT FILE SYSTEM OBJECT

    Dim objFSO As FileSystemObject
    Dim objFolder As folder
    Dim objFile As file
    Dim objTextStream As TextStream
    Dim strPath As String
    Dim i As Long
    Dim s As String, vSplit

    ' Specify the folder...
    strPath = "C:\Users\User\Desktop\TEST\"

    ' Use Microsoft Scripting runtime.
    Set objFSO = New FileSystemObject
    Set objFolder = objFSO.GetFolder(strPath)

    ' Check extension of each file in folder.
    For Each objFile In objFolder.Files
        If objFSO.GetExtensionName(objFile.Name) = "txt" Then
            Cells(i + 2, 1) = objFile.Name
            Set objTextStream = objFile.OpenAsTextStream(ForReading)
            'Cells(i + 2, 2) = objTextStream.ReadAll
            s = objTextStream.ReadAll
            vSplit = Split(s, "|")
            Range("b" & i + 2).Resize(1, UBound(vSplit) + 1) = vSplit
            i = i + 1
        End If
    Next
End Sub