VBA to important multiple files in directory, append

[Ajw43022]

Hi, I'd like to make a macro that imports all files in a directory that begin with "po", and then append them to each other in Excel. Would anyone know the code to do this? I'm having a great deal of trouble figuring it out. Here's my macro generated code for importing one of my files:

    Workbooks.OpenText Filename:="C:\InvestVFP\RBCData\RBCArchive\po042810.txt", _
        Origin:=xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
        xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False _
        , Comma:=True, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _
        Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), _
        Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15 _
        , 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1), Array(21, 1), _
        Array(22, 1), Array(23, 1))

thanks for any help!

 

[jbeaucaire]

Try this:

Option Explicit

Sub ImportTextFiles()
'Jerry Beaucaire   4/29/2010
Dim wsALL As Worksheet, wbData As Workbook
Dim fPath As String, fName As String
Dim fPathDone As String, OldDir As String
Dim NR As Long

'Setup
    Application.ScreenUpdating = False  'turn off screen updating, greatly increases speed
    Application.EnableEvents = False    'turn off all other macros
    Application.DisplayAlerts = False   'turn off system alerts, autoselects default answers
    
    If Not Evaluate("ISREF(Consolidated!A1)") Then  'create consolidation sheet if needed
        Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "Consolidated"
    Else
        Sheets("Consolidated").Cells.Clear
    End If
    Set wsALL = ThisWorkbook.Sheets("Consolidated")
    NR = 1
    
    fPath = "C:\InvestVFP\RBCData\RBCArchive\"  'remember final \ in this string
    fPathDone = fPath & "Imported\"             'remember final \ in this string
    On Error Resume Next
        MkDir fPathDone                         'creates the completed folder if missing
    On Error GoTo 0
    
    OldDir = CurDir             'memorizes the current working path
    ChDir fPath
    fName = Dir("po*.txt")      'filtering key, change to suit

'Import data found file
    Do While Len(fName) > 0
    'Open file
        Workbooks.OpenText Filename:=fPath & fName, Origin:=xlWindows, _
            StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
            ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, _
            Comma:=True, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), _
            Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
            Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), _
            Array(12, 1), Array(13, 1), Array(14, 1), Array(15, 1), Array(16, 1), _
            Array(17, 1), Array(18, 1), Array(19, 1), Array(20, 1), Array(21, 1), _
            Array(22, 1), Array(23, 1))
        ActiveSheet.UsedRange.Copy wsALL.Range("A" & NR)
        ActiveWorkbook.Close False
    'move imported file to imported folder
        Name fPath & fName As fPathDone & fName

        NR = wsALL.Cells.Find("*", Cells(Rows.Count, Columns.Count), _
            SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row + 1
        fName = Dir     'next filename
    Loop
    
'Cleanup
    wsALL.Columns.AutoFit
    wsALL.Rows.AutoFit
    Application.DisplayAlerts = True         'turn system alerts back on
    Application.EnableEvents = True          'turn other macros back on
    Application.ScreenUpdating = True        'refreshes the screen
    ChDir OldDir                             'restores users original working path
End Sub

This is an adaptation of one of my macros, found here.

 

[Ajw43022]

thanks, works great!