Creating a Macro to import Text files from a folder

[jbragg6625]

Hello,

I am very inexperienced at create macros but need to make one that will import all the text files from a specific folder. I tried using the macro recorder to do this but I'm not sure how to change the code so that it repeats the import process for each text file.

Also I need the last four rows of data from each text file to be deleted when they are imported.

Sub Transform()
'
' Transform Macro
' Transform JPMC File
'
' Keyboard Shortcut: Ctrl+t
'
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;C:Text Files\161.txt", Destination:=Range( _
        "$A$1"))
        .Name = "161"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 437
        .TextFileStartRow = 9
        .TextFileParseType = xlFixedWidth
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(2, 9, 2, 9, 2, 1, 2, 2, 1)
        .TextFileFixedColumnWidths = Array(16, 8, 11, 8, 16, 6, 12, 33)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=True
                        
End With
      
        Worksheets("Sheet1").Activate
        ActiveCell.CurrentRegion.Select
        
End Sub

This is the code that I currently have. It allows works on a specific file but not all files in the folder.

Can anyone help me with this?

 

[rpaulson]

try this,

Sub Import_All_Text_Files_2007()
    Dim nxt_row As Long
     'Change Path
    Const strPath As String = "C:\Test\" 'change path as needed
    Dim strExtension As String
     
     'Stop Screen Flickering
    Application.ScreenUpdating = False
     
    ChDir strPath
     
     'Change extension
    strExtension = Dir(strPath & "*.txt")
     
    Do While strExtension <> ""
            
         'Sets Row Number for Data to Begin
         
         
        nxt_row = Cells(Rows.Count, "A").End(xlUp).Row + 1
         
         'Below is from a recorded macro importing a text file
        With ActiveSheet.QueryTables.Add(Connection:= _
            "TEXT;" & strPath & strExtension, Destination:=Range("$A$" & nxt_row))
            .Name = strExtension
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .TextFilePromptOnRefresh = False
            .TextFilePlatform = 850
            .TextFileStartRow = 1
            .TextFileParseType = xlDelimited
            .TextFileTextQualifier = xlTextQualifierDoubleQuote
             'Delimiter Settings:
            .TextFileConsecutiveDelimiter = True
            .TextFileTabDelimiter = True
            .TextFileSemicolonDelimiter = True
            .TextFileCommaDelimiter = True
            .TextFileSpaceDelimiter = True
            .TextFileOtherDelimiter = "="
             
            .TextFileTrailingMinusNumbers = True
            .Refresh BackgroundQuery:=False
        End With
         
        strExtension = Dir
    Loop
     
    Application.ScreenUpdating = True
     
End Sub

Ross