Way to select multiple text files and import into one spreadsheet

[hansocool]

I've been googling around on ways to import multiple text files without just specifying the directory in the macro. I sort of tried to combine two codes together, one that lets me select the text files, and one that lets me put all the data onto one spreadsheet, but it's not working. Any ideas?

Sub CombineTextFiles()
    Dim FilesToOpen
    Dim x As Integer
    Dim wkbAll As Workbook
    Dim wkbTemp As Workbook
    Dim sDelimiter As String
    Dim myDir As String, fn As String, txt As String, y, delim As String
    Dim a(), n As Long, t As Long, maxCol As Integer
 
    On Error GoTo ErrHandler
    Application.ScreenUpdating = False
    sDelimiter = "|"
    FilesToOpen = Application.GetOpenFilename _
      (FileFilter:="Text Files (*.txt), *.txt", _
      MultiSelect:=True, Title:="Text Files to Open")
    If TypeName(FilesToOpen) = "Boolean" Then
        MsgBox "No Files were selected"
        GoTo ExitHandler
    End If
 
    ReDim a(1 To Rows.Count, 1 To Columns.Count)
    delim = vbTab
    fn = Dir(FilesToOpen & "\*.txt")
    Do While fn <> ""
        txt = CreateObject("Scripting.FileSystemObject").OpenTextFile(FilesToOpen & "\" & fn).ReadAll
        x = Split(Replace(txt, vbCrLf, delim), delim): t = t + 1: n = 1
        a(t, n) = fn
        For i = 0 To UBound(y)
            n = n + 1: a(t, n) = y(i)
        Next
        maxCol = Application.Max(maxCol, n)
        fn = Dir
    Loop
    ThisWorkbook.Sheets(1).Range("a1").Resize(t, maxCol).Value = a
 
 
 
ExitHandler:
    Application.ScreenUpdating = True
    Set wkbAll = Nothing
    Set wkbTemp = Nothing
    Exit Sub
ErrHandler:
    MsgBox Err.Description
    Resume ExitHandler
 
End Sub

I get a type mismatch error

 

[hansocool]

any ideas?

 

[hansocool]

Help would be greatly appreciated.

 

[Dartagnan]

This code might help or at least get you started. Code will prompt you for the name and then import the file into a new worksheet with the same name.

Sub import()

Dim file As String
Dim location
file = InputBox("Enter File Name")
Worksheets.Add().Name = file
location = "c:\" + file + ".txt"

Sheets(file).Select

With ActiveSheet.QueryTables _
.Add(Connection:="TEXT;" + location, Destination:=Range("A1"))
.Name = "{name the range - Optional}"
.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 = 1
.TextFileParseType = xlFixedWidth
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 9, 1, 1, 1, 1, 1, 1, 1, 9)
.TextFileFixedColumnWidths = Array(4, 1, 8, 20, 26, 16, 14, 13, 20)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With

End Sub