I am trying to create macro forto automatically import data from multiple .txt files located in a single folder. The data is comma delimited. Also I want it to check the last line of every file and if it says 0 records found then I do not want it to import the file. And I want the data imported onto one worksheet.
basic process is simple enough - the last line might cause an issue only in as much as you haven't specified what the record actually looks like on the last row
This code
Sub GetDataFromFolder() 'needs to have a reference set to microsoft scripting runtime Dim holdvar As String Dim counter As Long counter = Cells.SpecialCells(xlCellTypeLastCell).Row If counter = 0 Then counter = 2
Dim FSO As Scripting.FileSystemObject Dim SourceFolderName As String SourceFolderName = "c:\test\OpsRep\" 'amend this to the folder you want
Dim SourceFolder As Scripting.Folder, SubFolder As Scripting.Folder Dim FileItem As Scripting.File Dim r As Long
Set FSO = New Scripting.FileSystemObject Set SourceFolder = FSO.GetFolder(SourceFolderName) For Each FileItem In SourceFolder.Files ' display file properties msgbox FileItem.Path 'in reality, manipulate Next FileItem Set FileItem = Nothing Set SourceFolder = Nothing Set FSO = Nothing
End Sub
gives a means of finding files within a directory - you could then open each EITHER for input within code, or onto a blank worksheet - if the latter, then it is probably worth resetting the last cell each time - which this code does
Sub OptimizeWorkbook()
Dim ws As Worksheet
Dim lastrow As Long, lastcol As Long
Application.ScreenUpdating = False
On Error Resume Next
For Each ws In ActiveWorkbook.Worksheets
With ws
lastrow = .Cells.Find(what:="*", after:=.Range("A1"), LookIn:=xlValues, lookat:=xlPart, searchorder:=xlByRows, searchdirection:=xlPrevious).Row
lastcol = .Cells.Find(what:="*", after:=.Range("A1"), LookIn:=xlValues, lookat:=xlPart, searchorder:=xlByColumns, searchdirection:=xlPrevious).Column
Range(.Cells(1, lastcol + 1), .Cells(65536, 256)).Delete
Range(.Cells(lastrow + 1, 1), .Cells(65536, 256)).Delete
lastrow = .UsedRange.Rows.Count
End With
Next ws
On Error GoTo 0
Application.ScreenUpdating = True
End Sub
I'm happy to help further if needed - if it helps, my email is aidan.heritage@virgin.net
Advertisement