VBA使用Line Input遍历TXT文件时仅返回首个文件内容问题

问题根因 #

你代码中定义的text变量没有在每次读取新文件前清空，第一次读取文件后text已经存储了首个文件的全部内容，后续遍历其他文件时，都是将新文件的内容追加到text原有内容的末尾，你用Mid(text, 121, 9)取固定位置的字符串时，永远取到的都是首个文件对应位置的内容，所以第2列的值全部重复。

修复方案 #

在每次打开新文件读取内容之前，将text变量重置为空字符串即可。

修正后的完整代码 #

Sub ImportFileNames()

'Declarations
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer
Dim TextLine As String
Dim text As String

'Clears out old data
ActiveSheet.Columns(1).ClearContents
ActiveSheet.Columns(2).ClearContents

'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")

'Get the folder object
Set objFolder = objFSO.GetFolder("C:\Users\bbnewman\Desktop\Order Entry\EDIOrders")
i = 1

'loops through each file in the directory and prints their names and path
For Each objFile In objFolder.Files

    If (objFile.DateCreated < Date - 183) Or (Right(objFile.Name, 3) <> "txt") Then
    
        i = i + 1 'Skips noncompliant files
        
    Else
        
        'print body #
        Cells(i + 1, 1) = Left(objFile.Name, 7)
        
        ' 读取文件前先清空text变量，避免上一个文件内容残留
        text = ""
        
        'print PO#
        Open objFile For Input As #1
        
        Do While Not EOF(1)
            Line Input #1, TextLine
            text = text & TextLine
            Loop
        
        
        Cells(i + 1, 2).Value = Mid(text, 121, 9)
        
        Close #1
        
    i = i + 1
    
    End If

Next objFile

'Deletes blank lines
Columns("A").SpecialCells(xlBlanks).EntireRow.Delete

End Sub

额外优化建议 #

• 打开文件时建议使用FreeFile()函数获取可用文件号，避免固定使用#1出现文件号占用冲突
• 如果确认固定位置的字符串在文件前几行，不需要读取完整文件内容，可以匹配到对应位置后提前退出循环，提升运行效率

内容的提问来源于stack exchange，提问作者Brent Newman