3 Attachment(s)
Importing Multiple .Txt Files Into Excel Based on the Date Last Modified in VBA
Hello everyone,
I'd appreciate some coding help in Excel using VBA. I am new to this. :hi:
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.
Code:
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 :think: I'm using 365 btw.Attachment 27090Attachment 27091Attachment 27092
