VBA: Importing Multiple Text Files Without Header

[dariuzthepole]

Hi folks,

I've seen a few similar posts to this but not one that seems to fit my needs.

I'm looking to import multiple text files into the same sheet, placing subsequent text files below the previous one. I'd also like to remove the headers in the text file (just the first row) as the files are in daily batches and I'm importing months worth of data.

All the text files are in a single directory with no subfolders. These files are tab delimited but if possible I'd like to have a macro that covers comma delimited too as I'll be working with this type of file in the near future.

Any help would be greatly appreciated!

 

[Joe4]

What have you got so far?
Why don't you post it here?

Even if it does not do exactly what you want, you should be able to piece some code together using the Macro Recorder and stuff you have found on the internet (many people won't respond if they think you expect to do it all for them, but if you show some effort, you are much more likely to find people willing to help!). Then we can help you customize it to work for you.

 

[dariuzthepole]

Hi,

I have sourced a 'Get Directory' macro (see below) which allows the user to select the directory, in which the required text files are stored:

Sub OpenInputForm()
' open the form with a blank combobox
Load frmNumberInput
frmNumberInput.ComboBox1.Value = ""
frmNumberInput.Show
' sets the value for the Mymacro module to run
intID = frmNumberInput.ComboBox1.Value
End Sub

I have also recorded importing two of the files via the 'Get Text Data' function (see below).

Sub testimport()
'
' testimport Macro
'

    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;C:\Test\Sample1.txt" _
        , Destination:=Range("$A$1"))
        .Name = "130930_000000_26180_DUNDEE TIDE HEIGHT_1"
        .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
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
    Selection.End(xlDown).Select
    Range("A1442").Select
    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;C:\Test\Sample2.txt" _
        , Destination:=Range("$A$1442"))
        .Name = "131001_000000_26180_DUNDEE TIDE HEIGHT"
        .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
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1, 1, 1, 1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
End Sub

My stumbling blocks are:

• Merging these two by creating (I assume) some sort of FOR or WHILE loop.
• Tidying the import macro up so that the same parameters are used for all files (there must be a more efficient way than above)
• Removing the headers from each text file (first row only)

Hope that helps.

 

[Joe4]

Here is a thread that shows how to loop through multiple files in VBA that someone helped me with a similar question about 10 years ago, when I was just getting into higher level VBA: http://www.mrexcel.com/forum/excel-...ough-files-via-visual-basic-applications.html

Is there some way to identify which files are tab-delimited and which are CSV, simply by looking at the file names? If so, you can use and IF ... THEN ... ELSE statement to determine which import method to use for a particular file.

As far as removing file headers, note this argument:

.TextFileStartRow = 1

I am guessing if you set it to "2", it will skip your header row. Try it and see if it works!

 

[dariuzthepole]

Hi,

Thanks for the .TextFileStartRow hint. I've cobbled together other pieces of code I've found which originally imported text files into separate sheets. I'm struggling to modify it so that each subsequent file is placed underneath the previous one on the same sheet. The GetDirectory function is defined in another module so I can select the directory where the files are stored.

Sub ImportManyTXTs()
Dim folderPath As String
Dim ws As Worksheet


folderPath = GetDirectory


Do While folderPath <> vbNullString
[COLOR=#ff0000]Set ws = Sheets.Add[/COLOR]
With ws.QueryTables.Add(Connection:= _
    [COLOR=#ff0000]"TEXT;" & folderPath, Destination:=Range("$A$1"))[/COLOR]
[COLOR=#ff0000]    .Name = strFile[/COLOR]
    .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 = 2
    .TextFileParseType = xlFixedWidth
    .TextFileTextQualifier = xlTextQualifierDoubleQuote
    .TextFileConsecutiveDelimiter = False
    .TextFileTabDelimiter = True
    .TextFileSemicolonDelimiter = False
    .TextFileCommaDelimiter = False
    .TextFileSpaceDelimiter = False
    .TextFileColumnDataTypes = Array(1, 1, 1)
    .TextFileFixedColumnWidths = Array(7, 9)
    .TextFileTrailingMinusNumbers = True
[COLOR=#ff0000]    .Refresh BackgroundQuery:=False[/COLOR]
End With
Loop
End Sub

I've highlighted lines which I'm unsure of or causing errors. Unfortunately I've been spending too much time on this and I'll have to park/abandon this if I can't figure it out in the next few hours. Thanks for the assistance thus far.

 

[dariuzthepole]

I'm almost there!

Option Explicit


Sub ImportTextFile()


Dim fName As String
Dim objFile As Object
Dim objFolder As Object
Dim objFSO As Object
Dim folderPath As String
Dim lastrow As Long


ActiveSheet.Cells(1, 1).Select


folderPath = GetDirectory
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder(folderPath)
For Each objFile In objFolder.Files


    With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & objFile, [COLOR=#ff0000]Destination:=Range("A1")[/COLOR])
            .Name = "sample"
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .RefreshStyle = xlInsertEntireRows
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .TextFilePromptOnRefresh = False
            .TextFilePlatform = 437
            .TextFileStartRow = 2
            .TextFileParseType = xlDelimited
            .TextFileTextQualifier = xlTextQualifierNone
            .TextFileConsecutiveDelimiter = True
            .TextFileTabDelimiter = True
            .TextFileSemicolonDelimiter = False
            .TextFileCommaDelimiter = True
            .TextFileSpaceDelimiter = False
            .TextFileOtherDelimiter = "" & Chr(10) & ""
            '.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, _
            '   1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
            '   1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, _
            '   1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
            .TextFileTrailingMinusNumbers = True
            .Refresh BackgroundQuery:=False
    End With
    
    Range("A1").Select
    Selection.End(xlDown).Select
    ActiveCell.Offset(1, 0).Select
    
    Next
      
    Set objFolder = Nothing
    Set objFile = Nothing
    Set objFSO = Nothing


End Sub

I've highlighted the issue in red text in code window. Every time the next file is inserted into the sheet, it is put in A1 instead of being pasted below the previous file, as the last three lines of code before the NEXT command state. I've tried to remove this command but it seems it is a requirement.

Can anyone please help me with this last little bit?

 

[Joe4]

I am running off to a meeting, but here is a little something that may help. Before the import, you can identify the next available row in column A like this:

Dim myFirstBlankCell as String
myFirstBlankCell=Cells(Rows.Count,"A").End(xlUp).Offset(1,0).Address

Then try changing your argument to:

Destination:=Range(myFirstBlankCell)

 

[Bart196]

I am running off to a meeting, but here is a little something that may help. Before the import, you can identify the next available row in column A like this:

Dim myFirstBlankCell as String
myFirstBlankCell=Cells(Rows.Count,"A").End(xlUp).Offset(1,0).Address

Then try changing your argument to:

Destination:=Range(myFirstBlankCell)

Years later.... this information is valuable to me. Thank you for posting!!!