Home > Software design >  File not advancing for Line Input in VBA
File not advancing for Line Input in VBA

Time:09-25

This code intends to loop through a folder with multiple .txt files, then write a string from the file name into column 1 and a string from within the text file itself (it is in a fixed position) into column 2 using the Line Input function.

It returns the correct list in column 1, but column 2 is getting the value from the first file in each cell rather than the unique value from each file.

The objfile obviously advances, since the first column is getting a new value each time. And the Line Input obviously accepts the file as called since it retrieves the value from the first fine/ Why does it not also advance for the Line Input section?

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)
        
        
        '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

CodePudding user response:

You write text = text & TextLine , that means text will keep it's content and the new Textline is added at it's end. With other words, text gets longer and longer, but the beginning never changes.

All you have to do is to reset text for every file: Put a statement text = "" before you start reading the file.

    Open objFile For Input As #1
    text = ""
    Do While Not EOF(1)
        Line Input #1, TextLine
        text = text & TextLine
    Loop
  •  Tags:  
  • vba
  • Related