Import Multiple Text Files from a folder to multiple worksheets

[vincentzack]

As the title says I need to import multiple text files (all the same format) into an excel spreadsheet. The text files are saved in a folder, e.g. C:\Test. The path can be changed in the excel (like the attached excel, worksheet("Master"), cells (B1))

I want to import some of the text files from the folder (not import all) to separate worksheet. For example: import BEAMA.txt, then excel will have a sheet called BEAMA".

I only have the code to import the text file one by one. However, I need to import 50 nos. of text file out of 200. Could anyone help?


Sub ImportData()
Dim txtFileNameAndPath As String
Dim ImportingFileName As String, ImportingFileName2 As String
Dim SheetName As Worksheet
Dim fd As Office.FileDialog


Set fd = Application.FileDialog(msoFileDialogFilePicker)

With fd
'Enable this option if you want the use to be able to select multiple files
.AllowMultiSelect = False

'This sets the title of the dialog box.
.Title = "Please select the file."

'Sets the associated filters for types of files
.Filters.Clear
.Filters.Add "txt", "*.txt"
.Filters.Add "All Files", "*.*"

' Show the dialog box. If the .Show method returns True, the
' user picked at least one file. If the .Show method returns
' False, the user clicked Cancel.
If .Show = True Then
txtFileNameAndPath = .SelectedItems(1)
Else
MsgBox "Please start over. You must select a file to import"
'You don't want the sub continuing if there wasn't a file selected
Exit Sub
End If
End With

'Extracts only the file name for reference later
ImportingFileName = Right(txtFileNameAndPath, _
Len(txtFileNameAndPath) - InStrRev(txtFileNameAndPath, "\"))
'Nneed to be on the active worksheet for the below code to work
ImportingFileName2 = Left(ImportingFileName, Len(ImportingFileName) - 4)
ThisWorkbook.Sheets.Add.Name = ImportingFileName2
Worksheets(ImportingFileName2).Activate
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & txtFileNameAndPath _
, Destination:=Worksheets(ImportingFileName2).Range("$A2"))
.Name = "ImportingFileName"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 950
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub

[mdmackillop]

If i were to do this I would create a list of the files on a worksheet where an "x" can be inserted next to those to be imported. You can then loop through those indicated.

[vincentzack]

If i were to do this I would create a list of the files on a worksheet where an "x" can be inserted next to those to be imported. You can then loop through those indicated.

mdmackillop, Thanks for your idea! I got how to do it.

[mdmackillop]

Can you post your code for the benefit of others reading this thread.

[vincentzack]

Can you post your code for the benefit of others reading this thread.

The following code is a sample for what I want. If need to import a lot of text files, the code need to be amended. I'm still thinking how to do it.

Any idea or suggestions are welcome to discuss.

Sub Listfolder()
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer

'Create an instance of the FileSystemObject
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get the folder object
Set objFolder = objFSO.GetFolder(Sheets("Master").Range("B1"))
i = 1

'loops through each file in the directory and prints their names and path


For Each objFile In objFolder.Files
If objFile.Name = "BEAMD.TXT" Then
Sheets("BEAMD").Select
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;" & Sheets("Master").Range("B1") & "\BEAMD.TXT", Destination:=Range("$A$2"))
.Name = "BEAMD"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 950
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = True
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = True
.TextFileColumnDataTypes = Array(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

i = i + 1
Next objFile
End sub

[mdmackillop]

This needs adjusting to your locations

Sub GetFiles() Set sh = Sheet1
fld = "C:\TestDir\"
f = Dir(fld & "*.txt")
Do
i = i + 1
sh.Cells(i, 1) = fld & f
f = Dir
Loop Until f = ""

End Sub


Sub DoImport()
Set sh = Sheet1
With sh
Set r = Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp))
End With
For Each cel In r
If cel.Offset(, 1) <> "" Then
Sheets.Add after:=Sheets(Sheets.Count)
x = Split(Split(cel, "\")(UBound(Split(cel, "\"))), ".txt")(0)
ActiveSheet.Name = x
Call Import(cel.Value, x)
ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value
End If
Next
End Sub


Sub Import(f, query)
With ActiveSheet.QueryTables.Add(Connection:="TEXT;" & f _
, Destination:=Range("$A$2"))
.Name = query
.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, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub

[snb]

First of all: please use code tags !


If the directory is "G:\OF\"
If the filenames are written in column A
this code will suffice:


Sub M_snb()
sn = Columns(1).SpecialCells(2)

For Each it In sn
Sheets.Add , Sheets(Sheets.Count), , "G:\OF\" & it
Next
End Sub