Importing Multiple .Txt Files Into Excel Based on the Date Last Modified in VBA

[thelukeee]

Hello everyone,
I'd appreciate some coding help in Excel using VBA. I am new to this.



Goal of project:


1. The purpose of this code is the pull all of the files located the file name myPath="_____".
2. List out all the lines in the .txt files in seperate columns (a new row is created after each text file)
3. The goal is to be able to only pull files that have a 'lastModifiedDate' that are within a desired range (between 'Start Date' and 'End Date')
This is the purpose of the If statement. The contents of the .txt file should be saved in a unique row, with each line separated into columns.
If the 'lastDateModified' is outside the range, as applied in the Else statement, then it moves to the next .txt file.


Error: "Run-time error '55': File already open.


Note: I had success with the code without the date criteria. Everything was the same with the code except for the for and else loop. I'm assuming there is some sort of problem with the 'Close #1' statements but I am unsure...
The data in excel shows what I got from the text files without the date criteria. It takes a very long time to load ALL of the text files about (17,000 files spanning from 10 years ago). I want to be able to update my excel file possibly on a daily basis to import the new .txt files that are being created.


Thank you very much for any help.

Sub LoopThroughTextFiles()
' Defines variables
Dim myPath As String
Dim myFile As String
Dim myExtension As String
Dim Text As String
Dim Textline As String
Dim lastrow As Long
Dim colcount As Long


' Optimize Macro Speed
Application.ScreenUpdating = False
Application.EnableEvents = False

' Defines lastrow as the last column of data based on row 1
lastrow = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column
' Sets the folder containing the text files
myPath = "\\hsmpcs01\HCTMFG\FURNACE\AtmFurnace\Run Reports" & "\"

' Target File Extension (must include wildcard "*")
myExtension = "*.txt"

' Target Path with Ending Extention
myFile = Dir(myPath & myExtension)

StartDate = Worksheets("Intro").Range("B5")
EndDate = Worksheets("Intro").Range("B6")

' Loop through each text file in folder
Do While myFile <> ""
    ' Sets variable "colcount" To 1
    colcount = 1
    ' Sets variable "Text" as blank
    Text = ""
    ' Set variable equal to opened text file
    Open myPath & myFile For Input As #1

    lastModifiedDate = FileDateTime(myFile)

    If lastModifiedDate >= StartDate And lastModifiedDate <= EndDate Then
        ' Do until the last line of the text file
        Do Until EOF(1)
            ' Add each line of the text file to variable "Text"
            Line Input #1, Textline
            Text = Textline
            ' Update colcount row of the current last column with the content of variable "Text"
            Cells(lastrow, colcount).Value = Text
            ' Increase colcount by 1
            colcount = colcount + 1
        Loop
        ' Close the text file
        Close #1
        ' Increase lastrow by 1 to account for the new data
        lastrow = lastrow + 1
        ' Get next text file name
        myFile = Dir
    Else
        Close #1
    End If
Loop

ResetSettings:
' Reset Macro Optimization Settings
Application.EnableEvents = True
Application.ScreenUpdating = True

' Message Box when tasks are completed
MsgBox "Task Complete!"


End Sub

Picture 1: .txt files that are being imported

Picture 2: Example of one of the .txt files

Picture 3: All of the .txt files that were successfully imported to my excel file, but it took a long time and makes the file lag. I don't care about data from many years ago. I want to be able to only pull .txt files based on the date the file was last modified.

Note: I couldn't get the pictures to format correctly so you will have to match them yourselves I'm using 365 btw.HTTxtFiles.jpgInsideHTTextFile.jpgRaw HT Data.jpg

[thelukeee]

Thank you SamT for putting my code in the right format.