Excell import macro

Last Edited By Krjb Donovan
Last Updated: Mar 05, 2014 09:35 PM GMT

QuestionEdit

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.

AnswerEdit

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

©2024 eLuminary LLC. All rights reserved.